dies ist mein erster Beitrag und ich möchte mich kurz vorstellen. Ich heiße Kolja Ludwig und bin z.Zt. studentischer Mitarbeiter bei einer Berliner Beratungsfima im Automobilsektor.
Ich arbeite dort gerade an einm Excel-basiertem Tool zur Verwaltung einer Menge von bestimmten, gleichartigen Excel-Dokumenten. Eine Funktion dieses Tools ist es, ein solches Dokument auf den Stand eines ständig gepflegten Templates zu bringen. Dies umfasst alle Arbeitsblätter der Datei sowie den zugehörigen Makrocode. Im Template und den besagten Dateien befinden sich dabei Module aller Typen (ct_MSForm, ct_Document, ct_StdModule usw.).
Diese Update-Funktion funktioniert im Prinzip hervorragend, bis zu dem Punkt, an dem zum Schluss der Aktualisierungs-Routine der VBA-Code vom Template in die jeweils zu aktualisierende Datei übertragen werden soll. Der entsprechende Code läuft innerhalb des besagten Tools, weitere geöffnete Dateien sind das Template und die zu akt. Datei.
Das Problem liegt nun darin, daß Excel IMMER komplett abstürzt, wenn der Code in unten aufgelisteter Funktion in das jweilige Modul der Ziel-Datei eingefügt wird.
Ich habe (so denke ich) ALLE Möglichkeiten der Code-Übertragung ausprobiert: Import/Export über die eingebauten Methoden, mit .AddFromFile und .AddFromString, Zeilenweise, zeichenweise, und prozedurweise Übertragung. Dies auch jeweils mit/ohne aktivierten Events und noch etliche weitere Kombinationen. Nichts funktioniert.
Die unten stehende Funktion nutzt String-basierte Übertragung des Codes. Dies habe ich so gemacht, da bei der Nutzung der Export/Import-Funktionen vorher alle Module entfernt werden sollten (nat. mit Ausnahme der ct_Document-Module). Ein Modul und eine UserForm blieben dabei immer übrig, was einen Fehler beim Import der entsprechenden Module des Templates zur Folge hatte.
Hat jemand eine Idee, woran das Einfügen des Codes scheitert?
Noch kurz zum Verständnis: Da in dem Tool ständig mit mehreren offenen, gleichartigen Dateien hantiert wird, habe ich eine Klasse geschrieben, die eine solche Datei repräsentiert und einige immer wiederkehrende Operationen auf diesen Dateien kapselt (z.B. Arbeitsblätter sperren, Zeilen in eine Liste enfügen usw.). Dies ist der Typ 'Masterlist', welcher in der Signatur zu sehen ist.
Hier nun die Funktion:
Public Function transferVBACode(source As Masterlist, dest As Masterlist) As Boolean
Dim returnValue As Boolean
Dim FName As String
Dim VBComp As VBIDE.VBComponent
Dim VBCompInDest As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Dim ws As Worksheet
Dim wsInDest As Worksheet
Dim wsName As String
Dim sfx As String
Dim restoreScreenUpdating As Boolean
Dim restoreEvents As Boolean
Dim destWorkbook As Workbook
Dim sourceWorkbook As Workbook
Dim destVBComponents As VBComponents
Dim sourceVBComponents As VBComponents
Dim sourceFolderPath As String
Dim currentComp_Name As String
Dim currentComp_Type As Integer
Dim currentComp_Code As String
Dim newComp As VBComponent
Dim comp_match As Boolean
Dim search_ws_ml As Boolean
Dim i As Integer
If Application.ScreenUpdating = False Then
Application.ScreenUpdating = True
restoreScreenUpdating = True
End If
If Application.EnableEvents = True Then
Application.EnableEvents = False
restoreEvents = True
End If
' Projekte wenn nötig entsperren
If source.VBAProjectProtected = True Then
returnValue = source.UnlockVBAProject
If returnValue = False Then
transferVBACode = False
Exit Function
End If
End If
If dest.VBAProjectProtected = True Then
returnValue = dest.UnlockVBAProject
If returnValue = False Then
transferVBACode = False
Exit Function
End If
End If
' Workbook- und Component-Objekte initialisieren
Set destWorkbook = dest.GetMLWorkbook
Set sourceWorkbook = source.GetMLWorkbook
Set destVBComponents = destWorkbook.VBProject.VBComponents
Set sourceVBComponents = sourceWorkbook.VBProject.VBComponents
' ### Code der Zieldatei löschen ###
For Each VBComp In destVBComponents
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next VBComp
' ### Module kopieren ###
' Hier kommt es darauf an, den Code einer Komponente des Templates der richtigen
' Komponente der Zieldatei zuzuordnen. Diese Zuordnung kann eindeutig geschehen, wenn
' der Name und der Typ beider Komponenten übereinstimmen.
' Wird keine Entsprechung in der Zieltabelle gefunden, wird eine Komponente mit diesem
' Namen und Typ generiert und der Code dort eingefügt.
For Each VBComp In sourceVBComponents
' Namen (Worksheet-Name), Typ und Code der aktuellen Komponente des Templates auslesen
currentComp_Type = VBComp.Type
currentComp_Code = VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
If currentComp_Type vbext_ct_MSForm And VBComp.Name "DieseArbeitsmappe" Then
currentComp_Name = VBComp.Properties.Item("Name")
Else
currentComp_Name = VBComp.Name
End If
' Flag setzen für den Fall, daß die Komponente des Masterlisten-Arbeitsblattes
' gesucht werden soll. Dises Arbeitsblatt ist u. U. in den beiden Dateien
' unterschiedlich benamt.
If currentComp_Name = source.GetTableName Then
search_ws_ml = True
Else
search_ws_ml = False
End If
comp_match = False
' Jeweils Komponenten der Zieldatei durchlaufen und schauen, ob dort eine
' Komponente gleichen Names und Typs vorhanden ist
For Each VBCompInDest In destVBComponents
If VBCompInDest.Type = currentComp_Type Then
' Die Namen der Komponenten sind nicht bei jedem
' Modultyp aus der gleichen Eigenschaft auslesbar:
If currentComp_Type = vbext_ct_MSForm Or currentComp_Name = "DieseArbeitsmappe" _
_
Then
If VBCompInDest.Name = VBComp.Name Then
comp_match = True
End If
Else
If VBCompInDest.Properties.Item("Name") = currentComp_Name Or _
(search_ws_ml And VBCompInDest.Properties.Item("Name") = dest. _
GetTableName) Then
comp_match = True
End If
End If
End If
If comp_match Then
' Code einfügen (hierbei stürzt Excel komplett ab)
VBCompInDest.CodeModule.AddFromString String:=currentComp_Name
Exit For
End If
Next VBCompInDest
' Komponente ist in Zieldatei (noch) nicht vorhanden
If Not comp_match Then
Select Case VBComp.Type
' Für Klassen-Module und Standardmodule:
Case vbext_ct_StdModule, vbext_ct_ClassModule
' Neue Komponente des richtigen Typs erstellen
Set newComp = destVBComponents.Add(VBComp.Type)
' Code einfügen
newComp.CodeModule.AddFromString String:="Option Explicit"
' Nun müssen noch alle Eigenschafts-Werte der Komponente übertragen werden
' For i = 1 To VBComp.Properties.Count
' newComp.Properties.Item(i) = VBComp.Properties.Item(i)
' Next i
' Für UserForms:
Case vbext_ct_MSForm
' Noch nicht vorhandene Formulare lassen sich
' mit angemessenen Aufwand nur durch Exportieren/Importieren
' in die Zieldatei übertragen
FName = sourceFolderPath & "\" & VBComp.Name & ".frm"
VBComp.Export FName
destVBComponents.Import FName
Kill FName
Kill sourceFolderPath & "\" & VBComp.Name & ".frx"
Case vbext_ct_Document
End Select
End If
Next VBComp ' nächste Komponente
' Operation war erfolgreich, wenn wir bis hierher gekommen sind
transferVBACode = True
If restoreScreenUpdating Then
Application.ScreenUpdating = False
End If
If restoreEvents Then
Application.EnableEvents = True
End If
' Das aktive Projekt soll nun wieder dieses sein
Set Application.VBE.ActiveVBProject = ThisWorkbook.VBProject
Application.VBE.MainWindow.Visible = False
' Objekte freigeben
Set destWorkbook = Nothing
Set sourceWorkbook = Nothing
Set destVBComponents = Nothing
Set sourceVBComponents = Nothing
Set VBCompInDest = Nothing
Set newComp = Nothing
Set VBComp = Nothing
Set VBComps = Nothing
Set ws = Nothing
Set wsInDest = Nothing
End Function
Vielen Dank schon mal für Eure Hilfe!
Gruß,
Kolja