Rückmeldung
29.07.2007 15:33:00
Reinhard
Hallo Nepumuk,
ich mußte deinen Code leicht verunstalten damit er mehrmals in einem Modul nach einem Makronamen sucht.
Danke nochmals, das .Find klappt sehr gut.
Was mir noch einfiel, diesen pre-Tag, den habe ich mir gleich miteingebaut in diesen Javascript der hier die Kopfdaten des Antwortsfomulares ausfüllt.
D.h.
im meinemTextfeld bei einer Antwort steht nach dem Javascriptaufruf schon drin:
(natürlich zusammengeschrieben)
Gruß
Reinhard
Das spart Zeit und ist praktisch.
Nachfolgend noch mein fertiger Code der Makros in Modulen löscht bzw. einfügt.
Gruß
Reinhard
Option Explicit
Sub Loesch()
Call Makro_loeschen2("Sub Test")
End Sub
Sub Einfuegen()
Dim Makrotext As String
Makrotext = "Sub Test()" & Chr(13)
Makrotext = Makrotext & "'blabla" & Chr(13)
Makrotext = Makrotext & "End Sub" & Chr(13)
'Call Makro_Einfuegen(Makrotext, "Modul4", "ListeAllerMakros.xls")
'Call Makro_Einfuegen(Makrotext, "Modul4", "Mappe3")
Call Makro_Einfuegen(Makrotext, "Modul3")
Call Makro_Einfuegen(Makrotext)
'Call Makro_Einfuegen(Makrotext, , "Mappe3")
Call Makro_Einfuegen(Makrotext, "Tabelle2")
End Sub
Sub Makro_loeschen2(Makroname As String)
Dim CMdl, wb As Workbook, lngStartLine As Long, lngSearchLine As Long
Dim Finden
For Each wb In Workbooks
For Each CMdl In wb.VBProject.VBComponents
lngStartLine = 1
With CMdl.codemodule
While .Find(Makroname & "(", lngStartLine, 1, -1, -1, False, False, True)
If InStr(.Lines(lngStartLine, 1), Makroname & "(") = 1 Then
lngSearchLine = lngStartLine + 1
.Find "End Sub", lngSearchLine, 1, -1, -1, False, False, True
.DeleteLines lngStartLine, lngSearchLine - lngStartLine + 1
End If
lngStartLine = lngStartLine + 1
Wend
End With
Next CMdl
Next wb
End Sub
Sub Makro_Einfuegen(Makrotext As String, Optional Modulname As String, Optional Mappenname As _
String)Dim wb As Workbook, Vorh As Boolean, Fehlermeldung As String, Mdl
If Mappenname "" Then
For Each wb In Workbooks
If wb.Name = Mappenname Then
Vorh = True
Exit For
End If
Next wbElse
Mappenname = ThisWorkbook.Name
Vorh = True
End If
If Vorh = False Then
Fehlermeldung = "Mappe " & Mappenname & " nicht gefunden"
GoTo Fehler
End If
Vorh = False
If Modulname = "" Then Modulname = "Modul1"
For Each Mdl In Workbooks(Mappenname).VBProject.VBComponents
If Mdl.Name = Modulname Then
Vorh = True
Exit For
End If
Next Mdl
If Vorh = False Then
Workbooks(Mappenname).VBProject.VBComponents.Add(1).Name = Modulname
End If
With Workbooks(Mappenname).VBProject.VBComponents(Modulname).codemodule
.insertlines .CountOfLines + 2, Makrotext
End With
Exit Sub
Fehler:
MsgBox Fehlermeldung
End Sub