AW: Makro per Makro kopieren
29.07.2005 10:37:08
Heiko
Hallo Andreas,
wo sind den die Makros (DieseArbeitsmappe, Tabellenblatt, Userforms, Module, Klassenmodule) und willst du dann nur bestimmte oder alle überschreiben ?
Dieses Beispiel hier kopiert alle Module und Userforms von einer Mappe in eine neue.
Wenn dir der Name der Zielmappe bekannt ist mußt du das ja nur anpassen.
Reicht das als Anregung oder brauchst du mehr Input, dann Frag nach.
Das Zweite Script zeigt wie man VBA Inhalte löscht. Es ist natürlich sehr aufgebohrt, aber zeigt sehr schön wie es geht und was passiert. Muss man ich dan zum anwenden abspecken.
Private Sub CommandButton15_Click()
Dim strPath As String, strNewBookName As String
Dim vbc As Object
strPath = Application.Path & "\"
On Error GoTo Errorhandler
Workbooks.Add
strNewBookName = ActiveWorkbook.Name
ThisWorkbook.Activate
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
' Wenn Type = 1 dann ist es ein Standardmodul.
' Wenn Type = 3 dann ist es ein Userform
If vbc.Type = 1 Or vbc.Type = 3 Then
vbc.Export strPath & vbc.Name & ".txt"
Workbooks(strNewBookName).VBProject.VBComponents.Import strPath & vbc.Name & ".txt"
Kill strPath & vbc.Name & ".txt"
End If
Next vbc
End With
MsgBox "Module 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 Module exportieren!"
Else
MsgBox "Err.Number = " & Err.Number & ". " & Err.Description, vbCritical
End If
' Fehlernummer löschen.
Err.Clear
End Sub
Private Sub CommandButton11_Click()
' Mit diesem Sub wird die aktuelle Datei unter einem neuen Namen abgespeichert, und dann
' in der neuen Datei alle VBA Codes sowie alle Moduel und Userforms gelöscht.
' Es wird übrigens auch das Modul gelöscht, in dem sich dieses Makro befindet.
' So DIS 25.01.05
' Getestet auf EXCEL 2000 und EXCEL 2002/SP 2
' Sub VBAloeschen()
Dim vbc As Object
Dim strFile As String
'Abfrage ob die Datei ohne VBA Code gespeichert werden soll.
If MsgBox("Hiermit wird die aktuelle Datei 'ohne Makros' unter einem anderen Namen abgespeichert!", _
vbCritical + vbYesNo, " DIS 2005") = 6 Then
' Auf Laufwerk H wechseln
On Error Resume Next
ChDrive "H"
ChDir "H:\"
' Fehlerbehandlung aus.
On Error GoTo 0
' Den "Speichern unter" Dialog aufrufen.
strFile = Application.GetSaveAsFilename("Neuer Name", "Excel-Dateien (*.xls), *.xls")
' Wurde ein Dateiname zum "Speichern unter" ausgewählt dann weiter.
If strFile <> "" And strFile <> "Falsch" And strFile <> "False" Then
' Die Datei erstmal unter dem neuen Namen abspeichern.
ActiveWorkbook.SaveAs strFile
' bei Fehler zum Errorhandler
On Error GoTo Errorhandler
' Mit dem VBA Objekten in der aktiven Datei.
With ActiveWorkbook.VBProject
' Ein Schleife die ALLE VBComponents durchläuft, sollen nur bestimmte gelöscht werden
' dann muss dieser Code angepaßt werden.
For Each vbc In .VBComponents
Select Case vbc.Type
' Wenn Type = 1 dann ist es ein Standardmodul, dies wird komplett gelöscht!
Case 1
' Diese Abfragen können natürlich nach dem testen und verstehen raus.
If MsgBox("Ich bin ein Standardmodul ! Mein Name ist = " & vbc.Name & " ." & vbCr & _
"Möchtest du mich und meinen Code löschen ?", _
vbYesNo + vbInformation, " DIS 2005") = 6 Then
' Löschen des Standardmodules, mann kann auch Module dirket mit Namen
' ansprechen. Zb. Löscht die nächste Zeile Modul 1
' .VBComponents.Remove .VBComponents("Modul1")
.VBComponents.Remove .VBComponents(vbc.Name)
End If
' Wenn Type = 2 dann ist es ein Klassennmodul, dies wird komplett gelöscht!
Case 2
' Diese Abfragen können natürlich nach dem testen und verstehen raus.
If MsgBox("Ich bin ein Klassenmodul ! Mein Name ist = " & vbc.Name & " ." & vbCr & _
"Möchtest du mich und meinen Code löschen ?", _
vbYesNo + vbInformation, " DIS 2005") = 6 Then
' Löschen des Klassenmodules
.VBComponents.Remove .VBComponents(vbc.Name)
End If
' Wenn Type = 3 dann ist es ein Userform, dies wird komplett gelöscht!
Case 3
' Diese Abfragen können natürlich nach dem testen und verstehen raus.
If MsgBox("Ich bin ein Userform ! Mein Name ist = " & vbc.Name & " ." & vbCr & _
"Möchtest du mich und meinen Code löschen ?", _
vbYesNo + vbInformation, " DIS 2005") = 6 Then
' Löschen des Userforms
.VBComponents.Remove .VBComponents(vbc.Name)
End If
' Wenn Type = 100, also DieseArbeitsmappe oder ein Tabellenblatt, dann darin
' alle Codezeilen löschen. Denn die Datei und die Tabellenblätter sollen ja
' erhalten bleiben, also nur den Code löschen.
Case 100
' Diese Abfragen können natürlich nach dem testen und verstehen raus.
If MsgBox("Ich bin DieseArbeitsmappe oder ein Tabellenblatt ! " & vbCr & _
"Mein Name ist = " & vbc.Name & " . Möchtest du meinen Code löschen ?", _
vbYesNo + vbInformation, " DIS 2005") = 6 Then
With .VBComponents(vbc.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
End If
Case Else
MsgBox "Unbekannter VBA Type !", vbCritical
End Select
Next vbc
End With
' Wenn alles gelöscht wurde, dann raus hier!
Exit Sub
Else
MsgBox "Datei konnte nicht unter einem anderen Namen gespeichert werden !", vbCritical
Exit Sub
End If
' Bei Fehlernummer 1004, diese Meldung ausgeben.
Errorhandler:
If Err.Number = 1004 Then
MsgBox "Das Löschen 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 VBAloeschen"
Else
MsgBox "Err.Number = " & Err.Number & ". " & Err.Description, vbCritical
End If
End If
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !