Gibt es eine Möglichkeit mit einem Makro eine neue Arbeitsmappe anzulegen welche wiederum selbst ein Makro enthält?
Gruss Bernd
Sub TestT()
Workbooks.Add
' bei Fehler zum Errorhandler
On Error GoTo Errorhandler
' Hier geht dann auch VBComponents.Add und dann ein neues Modul einfügen.
' Oder statt AddFromString AddFromFile dann kann man einen Code aus einem File Laden
' Oder
ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule.AddFromString _
"Sub HalloO()" & vbCr & _
" MsgBox ""Dies ist das neue Makro!"", vbInformation" & vbCr & _
"End Sub"
Exit Sub
' Bei Fehlernummer 1004, diese Meldung ausgeben.
Errorhandler:
If Err.Number = 1004 Then
MsgBox "Das bearbeiten des VBA Codes ist fehlgeschlagen!" & vbCr & _
"Bitte überprüfen Sie folgende Einstellung! " & vbCr & _
"EXTRAS -> MAKRO -> SICHERHEIT -> Vertrauenwürdige Quellen." & vbCr & _
"'Zugriff auf Visual Basic Projekt vertrauen' muss aktiviert sein! ", vbCritical, _
" Meldung vom Makro TestT"
Else
MsgBox "Err.Number = " & Err.Number & ". " & Err.Description, vbCritical
End If
End Sub
Ein Beispiel mit EXPORT IMPORT
Private Sub CommandButton12_Click()
Dim strPath As String
strPath = Application.Path & "\"
' On Error GoTo Errorhandler
ThisWorkbook.VBProject _
.VBComponents("GlobaleVariable").Export strPath & "GlobaleVariable.bas"
Workbooks.Add 1
With ActiveWorkbook.VBProject
.VBComponents.Import strPath & "GlobaleVariable.bas"
.VBComponents("GlobaleVariable").Name = "MyModul"
End With
Kill strPath & "\GlobaleVariable.bas"
MsgBox "Modul wurde kopiert!"
Exit Sub
' Bei Fehlernummer 1004, diese Meldung ausgeben.
Errorhandler:
If Err.Number = 1004 Then
MsgBox "Das kopieren des VBA Moduls ist fehlgeschlagen!" & vbCr & _
"Bitte überprüfen Sie folgende Einstellung! " & vbCr & _
"EXTRAS -> MAKRO -> SICHERHEIT -> Vertrauenwürdige Quellen." & vbCr & _
"'Zugriff auf Visual Basic Projekt vertrauen' muss aktiviert sein! ", vbCritical, _
" Meldung vom Makro Modul kopieren!"
Else
MsgBox "Err.Number = " & Err.Number & ". " & Err.Description, vbCritical
End If
' Fehlernummer löschen.
Err.Clear
End Sub