AW: Alle Makros aus Mappe löschen
27.10.2024 11:46:48
ralf_b
da hab ich doch was in der Schatzkiste gefunden.
die Funktion benötigt den Namen der Datei als Parameter. Die Ddatei muß danach gespeichert werden, sonst macht das Code löschen keinen Sinn. Ich glaub das war so. Is schon ne Weile her.
Der Aufruf erfolgt über eine Sub.
Sub PrepBook()
If Not bRemoveAllCode(ActiveWorkbook.Name) Then
MsgBox "Error!", vbCritical, "bRemoveAllCode"
Else
ActiveWorkbook.save
End If
End Sub
Function bRemoveAllCode(ByVal szBook As String) As Boolean
Dim objCode As Object, objComponents As Object
Dim lCount As Long, wkbBook As Workbook
Const lModule As Long = 1
Const lForm As Long = 3
Const lOther As Long = 100
On Error GoTo bRemoveAllCodeError
Set wkbBook = Workbooks(szBook)
Set objComponents = wkbBook.VBProject.VBComponents
lCount = wkbBook.VBProject.VBComponents.Count
For Each objCode In objComponents 'Entfernt Module und Code
Debug.Print objCode.Type & " : " & objCode.Name
If objCode.Type > lOther Then
If objCode.Name = "deletevb" Then 'hier wird eine bestimmte Sub ausgeschlossen
Else
' Debug.Print lModule & " : " & objCode.Name
objComponents.Remove objCode
End If
ElseIf objCode.Type = lOther Then
objCode.CodeModule.DeleteLines 1, _
objCode.CodeModule.CountOfLines
End If
ActiveWorkbook.save
Next objCode
bRemoveAllCode = True
Exit Function
bRemoveAllCodeError:
bRemoveAllCode = False
End Function
