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

• #24947 Fferi50 Topikgazda pirit28 #24897

  Új Válasz 2015-01-09 12:44:42 #24947

  Ú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

  

  Fferi50

  Topikgazda

  válasz pirit28 #24897 üzenetére

  Szia!

  Bocs a hosszú hallgatás miatt! Remélem, még aktuális. Próbáld meg ezt:
  Sub okesit()
  Do
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = CurDir()
  If .Show Then
  okesito .SelectedItems(1), True
  Else
  If MsgBox("Nem választottál, befejezed?", vbYesNo, "Könyvtár választás") = vbYes Then Exit Sub
  End If
  End With
  Loop
  End Sub
  Sub okesito(ByVal konyvtar As String, ByVal alkonyvtaris As Boolean)
  Dim fs, fldr, subfldr, fld, fajl As String
  Set fs = CreateObject("Scripting.FilesystemObject")
  Set fldr = fs.GetFolder(konyvtar)
  fajl = Dir(fldr & "\*.xls*")
  Do While fajl <> ""
  Workbooks.OpenText Filename:=fldr & "\" & fajl
  ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
  'MsgBox fajl
  fajl = Dir()
  Loop
  If alkonyvtaris Then
  Set subfldr = fldr.subfolders
  For Each fld In subfldr
  fajl = Dir(fld & "\*.xls*")
  Do While fajl <> ""
  Workbooks.OpenText Filename:=fld & "\" & fajl
  ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
  'MsgBox fajl
  fajl = Dir()
  Loop
  Next
  End If
  End Sub

  Az okesit makrót kell elindítani, ott ki tudod választani azt a könyvtárat, amelyben (és alkönyvtáraiban) végre szeretnéd hajtani a műveletet.
  Ha a kiválasztott könyvtárban elvégzi a műveletet, akkor visszatér a választó ablak.
  A makróból úgy léphetsz ki, hogy a mégse gombot választod, vagy esc-t nyomsz és a kérdésre igent válaszolsz.
  Az előrehaladásra nem tettem bele információ kijelzést, a státuszsoron esetleg kiírathatod pl. a kikommentelt msgbox helyére, Application.StatusBar = fajl
  akkor a végére pedig Application.StatusBar=False

  Üdv.

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