AW: Makro aus einer anderen Exceldatei "vererben"
13.10.2016 17:28:55
Bastian
Hey Christian so müsste das dann aussehen nicht gerade schön aber es geht ;)
Gruß Basti
Sub Start()
Call Makro_ExPort_import
Call CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
Call test ' hier wird das Kopierte Makro von Modul1 was sich noch auf der HauptMakro Excel _
Datei befunden hat gestartet
End Sub
Sub Makro_ExPort_import() ' Verweis auf VB for Applications Extensibility setzten
Dim objExportCodeModule As Object, objImportVBComponents As Object, WB As Workbook
Dim MODName As String
Application.DisplayAlerts = False
Ordner = "C:\Users\" & Environ("Username") & "\Desktop" ' Pfad zur HauptMakro Excel Datei
DateiName = "Mappe2.xlsm" ' Name der HauptMakro Excel Datei
MODName = "Modul1" ' Name des Moduls in diesem Modul muss _
ein Makro mit dem Namen Test sein weil es am ende dieses codes ausgeführt wird
Set WB = Workbooks.Open(Ordner & "\" & DateiName)
Set objExportCodeModule = WB.VBProject.VBComponents(MODName).CodeModule
Call VBkompSuche(ThisWorkbook, MODName)
Set objImportVBComponents = ThisWorkbook.VBProject.VBComponents.Add(1) ' 1=Standardmodul
objImportVBComponents.Name = MODName
With objImportVBComponents.CodeModule
.DeleteLines 1, .CountOfLines ' Vorsichtshalber alle Zeilen loeschen
.InsertLines 1, objExportCodeModule.Lines(1, objExportCodeModule.CountOfLines)
End With
Set objExportCodeModule = Nothing
Set objImportVBComponents = Nothing
WB.Close
Set WB = Nothing
Application.DisplayAlerts = True
End Sub
Function VBkompSuche(WB As Workbook, SuchName As String) As Boolean
Dim VBkomp As VBComponent
On Error Resume Next
With WB
For Each VBkomp In WB.VBProject.VBComponents
If VBkomp.Name = SuchName Then
VBkompSuche = True
VBkomp.Name = "DELETE"
.VBProject.VBComponents.Remove VBkomp
Exit Function
End If
Next VBkomp
End With
End Function