AW: Makros in/ von Datei exportieren importieren
06.05.2010 08:40:50
Datei
Hallo Horst,
für eine Datei.
Option Explicit
Public Sub alleMakrosExportieren()
' von Nepumuk
' Export des gesamten Codes
' aus ThisWorkbook
' vor Export sollten bereits vorhandener Code im Verzeichnis gelöscht werden
' damit es mit dem Import Fehlerfrei geht
Dim vbc As Object, iCounter As Integer, sMacro As String, cType As String
For Each vbc In ThisWorkbook.VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Or InStr(1, .Lines(iCounter, 1), "Dim") 0 _
Or InStr(1, .Lines(iCounter, 1), "Public") 0 _
Or InStr(1, .Lines(iCounter, 1), "Type") 0 _
Or InStr(1, .Lines(iCounter, 1), "Static") 0 _
Or InStr(1, .Lines(iCounter, 1), "Declare") 0 Then
Select Case vbc.Type
Case 1: cType = ".bas"
Case 2, 100: cType = ".cls" 'Tabelle; DieseArbeitsmape
Case 3: cType = ".frm"
End Select
' Ablagephad
Workbooks(ThisWorkbook.Name).VBProject.VBComponents(vbc.Name).Export _
"C:\Windows\Temp\" & vbc.Name & cType
Exit For
End If
Next iCounter
End With
Next vbc
End Sub
Public Sub Import1()
' von Nepumuk
Dim vbc As Object, iCounter As Integer, StDateiname As String
With ThisWorkbook.VBProject ' Workbooks("Testmappe.xls").VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
StDateiname = Dir("C:\Windows\temp\" & "*.*")
Do While StDateiname ""
If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" _
_
_
_
Or UCase(Right(StDateiname, 4)) = ".CLS" Then
.VBComponents.Import "C:\Windows\Temp\" & StDateiname
End If
StDateiname = Dir
Loop
For Each vbc In .VBComponents
If vbc.Type = 2 Then
If Left(vbc.Name, 5) = "Diese" Or Left(vbc.Name, 7) = "Tabelle" Then
.VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1, _
_
_
_
vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
.VBComponents.Remove .VBComponents(vbc.Name)
End If
End If
Next vbc
End With
End Sub