Új hozzászólás Aktív témák

• #5948 Fire/SOUL/CD félisten Pulsar #5946

  Új Válasz 2010-01-08 20:03:00 #5948

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fire/SOUL/CD

  félisten

  válasz Pulsar #5946 üzenetére

  Hali!

  Ahhoz, hogy ezt megtehesd, az excel tábla útvonalából ki kell emelni a fájlnevet például. Az alábbi makró ezt teszi. (a fájl kiterjesztést törli) Aztán, hogy a kapott névvel új munkalapot hozol-e létre, vagy egy meglévőt átnevezel, az már rajtad áll.

  Private Sub CommandButton1_Click()
  
  Dim Excel_Filename As String
  Dim Point As String
  Dim BackSlash As String
  Dim BackSlashPos As Integer
  
  'értékadás
  Excel_Filename = "c:\a\b\abcdefg.xlsx"
  BackSlash = "\"
  Point = "."
  
  'található-e benne visszaper jel
  BackSlashPos = InStr(1, Excel_Filename, BackSlash, vbTextCompare)
  
  'jobbról balra megkeressük az első pontot(.), hisz addig tart a fájl kiterjesztése
  'majd kitöröljük
  For i = Len(Excel_Filename) To 1 Step -1
  c = Mid(Excel_Filename, i, 1)
  If c = Point Then
  Exit For
  End If
  Next
  Excel_Filename = Left(Excel_Filename, Len(Excel_Filename) - (Len(Excel_Filename) - i + 1))
  
  'ha korábban nem találtunk benne visszaper jelet, akkor az azt jelenti
  'hogy nem tartalmazott útvonalat, csak egy sima fájlnév, ez esetben nem kell
  'megkeresni az első visszaperjelet ismét jobbról balra. (azaz magát a fájl nevét)
  If BackSlashPos <> 0 Then
  For i = Len(Excel_Filename) To 1 Step -1
  c = Mid(Excel_Filename, i, 1)
  If c = BackSlash Then
  Exit For
  End If
  Next
  Excel_Filename = Mid(Excel_Filename, i + 1, (Len(Excel_Filename) - i + 1))
  End If
  MsgBox (Excel_Filename)
  
  End Sub

  Fire.

  [ Szerkesztve ]

  Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

Új hozzászólás Aktív témák