AW: Makro auf mehrere Dateien anwenden
12.12.2005 12:56:47
Peterchen
Hi Alex,
hier die Lösung denke ich.
du musst vorher noch unter Extra-Verweise
die "Microsoft Scripting Runtime" anhaken,
damit es die Objekte: FileSystemObject,
Folder und File auch gefunden werden.
Beste Gruesse Peterchen
-----------------------------------------------
'Alle Variabel deklarieren:
Option Explicit
'automatisch ein FileSystemObjekt anlegen:
Public fso As New FileSystemObject
Sub Alle_Dateien()
Dim Verz As Folder 'Verzeichniss-Objekt anlegen
Dim Datei As File 'Datei-Objekt anlegen
Dim wb As Workbook
'Das Verzeichniss-Objekt mit dem Verzeichniss
'der geöffneten Datei zuweisen:
Set Verz = fso.GetFolder(ActiveWorkbook.Path)
'Nun alle Dateien in dem Ordner durchgehen
For Each Datei In Verz.Files
'Wenn es eine Excel Datei ist
If UCase(Right(Datei.Name, 3)) = "XLS" Then
'Wenn die Datei noch nicht geoeffnet ist oeffnen
If Not WorkbookIsOpen(Datei.Name) Then
If Right(Datei.Path, 1) = "\" Then
Workbooks.Open Datei.Path & Datei.Name
Else
Workbooks.Open Datei.Path & "\" & Datei.Name
End If
End If
'Die Datei zuweisen und aktivieren
Set wb = Workbooks(Datei.Name)
wb.Activate
'hier nun dein Makro aufrufen
Call das_makro_was_in_allen_laufen_soll
'eventuell die Datei speichern und schliessen
wb.Save
wb.Close
End If
Next
End Sub
'Pruefung ob die Datei schon in Excel geoeffnet ist
Function WorkbookIsOpen( _
ByVal WorkbName As String _
) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = WorkbName Then
WorkbookIsOpen = True
Exit Function
End If
Next
WorkbookIsOpen = False
End Function