Makros aus vielen Tabellen entfernen
08.10.2015 17:22:24
Chrischan
Ich möchte gerne aus vielen *xlsm Dateien die Makros löschen. (und ein Tabellenblatt ausblenden, wobei der Teil dann einfach sein sollte) Dazu gibt es eine "Masterdatei", in welcher ein Makro gestartet wird, von wo aus dann die anderen Tabellen geöffnet, bearbeitet und danach wieder abgespeichert und geschlossen werden sollen.
In diesem Forum hier hatte ich bereits eine ähnliche Fragestellung gefunden und versucht diese anzuwenden. Jedoch leider ohne Erfolg. (https://www.herber.de/forum/archiv/1044to1048/1046434_Makros_in_mehreren_Dateien_ausfuehren.html)
Aktuell scheitert es daran, dass ich die Meldung bekomme, dass die Funktion Worbooks.Open fehlschlägt. Ich habe auch schon danach gesucht, jedoch habe ich keine Lösung gefunden. (falscher Pfad oder ähnliches) Ich verstehe leider auch die Behandlung der Objekt Geschichten zu wenig um da alleine weiter voranzukommen.
Ich hoffe, dass mir jemand helfen kann. Ich habe das Gefühl, dass das Problem relativ trivial ist, ich allerdings nicht darauf komme.
Vielen Dank bereits im Voraus.
Der verwendete Code:
' Modul: Modul1 Typ: Allgemeines Modul
Option Explicit
Sub AnwendungMakrosVerzeichnis()
Dim strInitialPath As String, strpath As String
Dim objWB As Workbook
Dim objFSO As Object
Dim objFSODirectory As Object 'Verzeichniss-Objekt anlegen
Dim objFSOFile As Object 'Datei-Objekt anlegen
On Error GoTo ErrExit
GMS
strInitialPath = "C:\" 'Root-Verzeichnis zur Verzeichnisauswahl
strpath = fncBrowseForFolder(strInitialPath)
If strpath = "" Then GoTo ErrExit
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Das Verzeichniss-Objekt mit dem Verzeichniss
'der geöffneten objFSOFile zuweisen:
Set objFSODirectory = objFSO.GetFolder(strpath)
'Nun alle Dateien in dem Ordner durchgehen
For Each objFSOFile In objFSODirectory.Files
'Wenn es eine Excel objFSOFile ist
If UCase(Right(objFSOFile.Name, 3)) = "XLS" Then
'Wenn die objFSOFile noch nicht geoeffnet ist oeffnen
If Not WorkbookIsOpen(objFSOFile.Name) Then
Set objWB = Workbooks.Open(objFSOFile.Path)
Else
Set objWB = Workbooks(objFSOFile.Name)
End If
objWB.Activate
'hier nun das Makro aufrufen
Call HideBlatt
'Call DeleteMakros
'eventuell die objFSOFile speichern und schliessen
objWB.Close True
Set objWB = Nothing
End If
Next
ErrExit:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & _
"Beschreibung: " & Err.Description, vbExclamation, "Fehler"
GMS True
Set objFSO = Nothing
Set objFSOFile = Nothing
Set objFSODirectory = Nothing
Set objWB = Nothing
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object
Set objShell = CreateObject("Shell.Application")
Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
If objFlder Is Nothing Then GoTo ErrExit
Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path
ErrExit:
Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function
'Pruefung ob die objFSOFile schon in Excel geoeffnet ist
Function WorkbookIsOpen( _
ByVal WorkbName As String _
) As Boolean
Dim objWB As Workbook
For Each objWB In Workbooks
If objWB.Name = WorkbName Then
WorkbookIsOpen = True
Exit Function
End If
Next
End Function
Private Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub
Sub HideBlatt()
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(4).Visible = False
Application.DisplayAlerts = True
End Sub