Makro löscht Makro
Mark
bin neu hier im Forum.
Habe eine Frage bezüglich eines "Löschmich" Makros.
Habe ein excel sheet mit mehreren Makros, die auch alle problemlos funktionieren.
Möchte nun mein "Start Makro" löschen um meinen Kollegen den Zugriff auf diese Datei zu ermöglichen.
Start Makro: .xlt öffnet/überschreibt .xls und öffnet 2. Prog welches wiederrum Daten in die .xls schreibt.
Option Explicit
Private Sub Workbook_Open()
Dim s As String
Dim f As Object
Dim myappid
s = "C:\TestDaten\Test.xls"
If workbookIsOpened("Test.xls") Then Exit Sub
If ActiveWorkbook.FullName s Then
Set f = CreateObject("Scripting.FileSystemObject")
If f.FileExists(s) Then
' MsgBox "File vorhanden"
If MsgBox("Achtung: Vorhergehende Messung gesichert?" & vbCrLf & _
"Wollen Sie die vorhergehende Messung '" & s & "' überschreiben?", vbOKCancel _
_
+ vbExclamation, "Hinweis") = vbOK Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=s
Application.DisplayAlerts = True
myappid = Shell("C:\programme\Müller\Müller.exe C:\programme\Müller\Schaltbilder\ _
Test.dsb", vbMaximizedFocus)
Else
MsgBox "Bitte das File '" & s & "' unter anderem Namen sichern!", vbOKOnly + _
vbInformation
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
End If
End If
Set f = Nothing
End If
End Sub
Private Function workbookIsOpened(name As String) As Boolean
On Error GoTo workbook_opened
Dim wb As Workbook
Set wb = Workbooks(name)
workbookIsOpened = True
Exit Function
workbook_opened:
workbookIsOpened = False
End Function
Folgendes Problem:
Sub Makro_löschen()
Dim FoundFlag As Boolean
Dim Zeilen()
Makroname = "Workbook_Open"
Suchtext = "Sub " & Workbook_Open & "()"
Set VBE = Application.VBE.ActiveCodePane.CodeModule
FoundFlag = False
With VBE
For x = 1 To .CountOfLines
If UCase(.Lines(x, 1)) = UCase(Suchtext) Then FoundFlag = True
If FoundFlag Then
Zähler = Zähler + 1
ReDim Preserve Zeilen(Zähler)
Zeilen(Zähler) = x
If .Lines(x, 1) = "End Sub " Then
.DeleteLines Zeilen(1), UBound(Zeilen)
Exit For
End If
End If
Next x
If Not FoundFlag Then MsgBox "Makro " & Workbook_Open & " nicht gefunden !", vbCritical
End With
End Sub Test.xls - Modul1 ( Code)
Löscht bezw. findet mein Makro nicht
Hat jemand eine Lösung
Danke