Code per VBA entfernen, Code-Probe
Hans Faber
habe z.Zt. ein Riesenproblem mit dem Entfernen von VBA-
Code aus einer Excel-Datei (Excel 2000, Win NT 4.0).
Doktere schon den ganzen Nachmittag daran herum, ohne
wirklich weiter zu kommen. Dabei habe ich ähnliche
Routinen in anderen Anwendungen, die problemlos
funktionieren. Und ich sehe einfach nicht, wo`s hier jetzt
klemmt. Mit Googlesuche in der NG bin ich auch nicht
fündig geworden. Vielleich hat ja jemand mal Lust, sich
folgenden Code einmal anzusehen?
Es geht folgenden:
Ich habe eine Datei Verwaltung.xls, in der in Spalte A die
Dateinamen der zu bearbeitenden Dateien sind. Hier wählen
ich die Datei aus (strDateiName), von der ich dann per VBA
eine Archivdatei erstellen will, die nur noch Werte und
Formate enthält und auch keinen VBA-Code mehr. Diese
Archivdatei soll in einen Unterordner Archiv verschoben
werden.
Nach dem Start von <Sub ArchivDateiErstellen> wird <Sub
CodeEntfernen> aufgerufen. Beide Routinen laufen
fehlerfrei durch. Allerdings wird der VBA-Code nicht
entfernt !!!
Kann mir hier jemand den goldenen Tip geben?
Tausend Dank im Voraus!
Herzliche Grüße,
Hans
Sub ArchivDateiErstellen()
Set WBVerwaltung = ActiveWorkbook
WBVerwaltung.Activate
'Variablen initialisieren
strPfad = ActiveWorkbook.Path & Application.PathSeparator
strDateiNameALT = strPfad & strDateiName
strDateiNameNEU = strPfad & "Archiv" & _
Application.PathSeparator & strDateiName
'Verschieben in Unterordner Archiv
Name strDateiNameALT As strDateiNameNEU
'Workbook (=WBBetrieb =strDateiNameNEU) öffnen
Workbooks.Open Filename:=strDateiNameNEU
Set WBBetrieb = ActiveWorkbook
'Schutz in WBBetrieb aufheben
WBBetrieb.Activate
Sheets("Berechnung").Select
Sheets("Berechnung").Activate
'Archivbereich kopieren und als Werte einfügen
Application.GoTo Reference:="Archivbereich"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
'Steuerelemente entfernen
ActiveSheet.DrawingObjects.Delete
'Namen löschen
For Each myName In WBBetrieb.Names
myName.Delete
Next
'ausgeblendete Blätter löschen:
With Application
.DisplayAlerts = False
Sheets("001").Delete
Sheets("002").Delete
.DisplayAlerts = True
End With
'Schutz aktivieren
With Cells
.ClearComments
.Locked = True
.FormulaHidden = True
End With
'VBA-Code entfernen
Call CodeEntfernen '-----> siehe folgende Sub
Workbooks(strDateiName).Close SaveChanges:=True '???
Application.DisplayAlerts = True
'WBVerwaltung:
WBVerwaltung.Activate
End Sub
Sub CodeEntfernen()
'Benötigt Verweis auf:
'"Microsoft Visual Basic for Applications Extensibility"
'(in Excel 2000 und 2002 mit Versionszusatz "5.3")
Dim objKomponente As VBComponent
Dim objKomponenten As VBComponents
Dim objVBAProjekt As VBProject
Dim objVerweis As Reference
Dim objBlatt As Worksheet
Dim objDialogblatt As DialogSheet
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
Set objVBAProjekt = ActiveWorkbook.VBProject
Set objKomponenten = objVBAProjekt.VBComponents
For Each objKomponente In objKomponenten
With objKomponente
Select Case .Type
Case vbext_ct_StdModule, _
vbext_ct_ClassModule, _
vbext_ct_MSForm
objKomponenten.Remove objKomponente
Case vbext_ct_Document
.CodeModule.DeleteLines _
1, .CodeModule.CountOfLines
End Select
End With
Next
For Each objVerweis In objVBAProjekt.References
If Not objVerweis.BuiltIn Then
objVBAProjekt.References.Remove objVerweis
End If
Next
Application.DisplayAlerts = False
For Each objBlatt In Excel4MacroSheets
objBlatt.Delete
Next
For Each objDialogblatt In DialogSheets
objDialogblatt.Delete
Next
Application.DisplayAlerts = True
End If
End Sub
Thomas Ramel
Hans Faber schrieb:
>
> Es geht folgenden:
> Ich habe eine Datei Verwaltung.xls, in der in Spalte A die
> Dateinamen der zu bearbeitenden Dateien sind. Hier wählen
> ich die Datei aus (strDateiName), von der ich dann per VBA
> eine Archivdatei erstellen will, die nur noch Werte und
> Formate enthält und auch keinen VBA-Code mehr. Diese
> Archivdatei soll in einen Unterordner Archiv verschoben
> werden.
> Nach dem Start von <Sub ArchivDateiErstellen> wird <Sub
> CodeEntfernen> aufgerufen. Beide Routinen laufen
> fehlerfrei durch. Allerdings wird der VBA-Code nicht
> entfernt !!!
> Kann mir hier jemand den goldenen Tip geben?
Hmmm , ich hab den Code (noch) nicht genauer angesehen- aber hast Du schon
versucht, die einzelnen Mappen in einer älteren Excel-Version zu sichern,
als xl95-Datei zum Beispiel?
Wenn Du nur noch Werte und Formate haben willst, fällt alles andere beim
Speichern im 95-er Format weg - auch der VBA-Code.
Das Ganze könntest Du ja ebenfalls per VBA machen.
Nur mal als Idee.
--
Mit freundlichen Grüssen
Thomas Ramel
- MVP für Microsoft-Excel -
[Win 2000Pro SP-4 / xl2000 SP-3]
Thomas Ramel
Thomas Ramel schrieb:
>
> Hmmm , ich hab den Code (noch) nicht genauer angesehen- aber hast Du
> schon versucht, die einzelnen Mappen in einer älteren Excel-Version zu
> sichern, als xl95-Datei zum Beispiel?
> Wenn Du nur noch Werte und Formate haben willst, fällt alles andere beim
> Speichern im 95-er Format weg - auch der VBA-Code.
Als Excel4-Arbeitsmappe speichern, dann ist aller Code weg
anon...@discussions.microsoft.com
Danke für Deine Antwort. Ist eigentlich eine gute Idee und
funktioniert auch, das Ergebniss ist aber nicht genau das
was ich eigentlich haben will, weil beim Speichern im 4er
Format auch die bedingten Formatierungen futsch sind.
Außerdem dürfte die Mappe dann auch nur noch ein Blatt
enthalten. Ich brauche wohl doch die reine VBA-Lösung, die
den Code einfach entfernt.
Vielleicht kannst Du (oder sonst wer), sich den Code
(s.0.) doch noch mal anschauen. Der müßte doch eigentlich
funktionieren.
Gruß, Hans
>-----Originalnachricht-----
>.
>
stefan onken
ich habe den Teil deines Codes, der die Module etc
löscht, in ein Modul kopiert, den Verweis gesetzt und den
Code ausgeführt, und es wurden alle Codefragmente einer
anderen (der aktiven) Mappe gelöscht.
Hast du den Verweis tatsächlich gesetzt (wenn nicht,
sollte es eigentlich eine Fehlermeldung geben bei der
Dimensionierung der Variablen)?
Eine weitere Möglichkeit wäre, dass die Bedingung
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
False ist und deshalb der Code nicht ausgeführt wird.
Setzte hinter/unter die Bedingung testweise mal ein
MsgBox.
Gruß
stefan
>-----Originalnachricht-----
>.
>
Hans Faber
danke für Deine Hinweise. Der Verweis ist richtig gesetzt.
Und wenn ich hinter:
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
die Abfrage:
MsgBox "ActiveWorkbook: " & ActiveWorkbook.Name & vbLf & _
"ThisWorkbook: = " & ThisWorkbook.Name
schalte, erhalte ich auch die richtige wbk-Namen. Nun habe
ich allerdings folgendes festgestellt:
Zu dem Zeitpunkt, wo der call CodeEntfernen fertig ist,
ist laut VBA-Projektexplorer in ActiveWorkbook auch alles
richtig entfernt. In Excel ist dann allerdings das Fenster
von ActiveWorkbook nicht mehr da. Das eigentliche Problem
besteht wohl darin, ActiveWorkbook nach
Call CodeEntfernen
richtig zu beenden. Mit
ActiveWorkbook.Save
oder
ActiveWorkbook.Close SaveChanges:=True
klappt es nicht.
Wenn ich allerdings mit exit rausgehe, also
Call CodeEntfernen
Exit Sub
dann lande ich im Fenster von ActiveWorkbook. Will ich das
schließen, werde ich gefragt, ob ich die Änderungen
übernehmen will oder nicht. Bestätige ich mit ja, wird die
Archivdatei korrekt erstellt und ich bin wieder in
Verwaltung.xls (Thisworkbook).
Gibst es hier keinen anderen (eleganteren) Weg?
Gruß, Hans
Hast Du
>-----Originalnachricht-----
>.
>
stefan onken
nach Beenden von CodeEntfernen steht ja nur noch eine
Befehlszeile:
Workbooks(strDateiName).Close SaveChanges:=True
Geöffnet hast du die Datei weiter oben im Code aber als
strDateiNameNEU. Deshalb werden die Änderungen auch nicht
gespeichert.
Liegts vielleicht daran?
Gruß
stefan
>-----Originalnachricht-----
>.
>
Hans Faber
Danke, aber ich glaub nicht, daß es daran liegt. Vor dem
ganzen Entfernen von Namen, Formeln, Code etc. wird die zu
archivierende Datei (strDateiName) in ein
Unterverzeichnis "Archiv verschoben". Die Variable
strDateiName ist an anderer Stelle als Public deklariert
(wird öfter gebraucht).
...
'Variablen initialisieren
strPfad = ActiveWorkbook.Path & Application.PathSeparator
strDateiNameALT = strPfad & strDateiName
strDateiNameNEU = strPfad & "Archiv" & _
Application.PathSeparator & strDateiName
'Verschieben in Unterordner Archiv
Name strDateiNameALT As strDateiNameNEU
'Workbook (=WBBetrieb =strDateiNameNEU) öffnen
Workbooks.Open Filename:=strDateiNameNEU
strDateiNameNEU ist also nur NeuerArchivPfad+strDateiName.
Der Dateiname selbst hat sich nicht geändert. Und deshalb
müßte doch
Workbooks(strDateiName).Close SaveChanges:=True
richtig sein, oder nicht?
Bei:
Workbooks(strDateiNameNeu).Close SaveChanges:=True
krieg ich dann einen Fehler, weil in strDateiNameNeu noch
der ganze Pfad davorsteht.
Gruß, Hans
>-----Originalnachricht-----
>.
>
stefan onken
nee, stimmt, daran liegts nicht, das war zu schnell
geschossen.
Ich habe nun den kompletten Code mal nachgebaut und habe
(in XP) keinerlei Probleme. Alle Codezeilen und Module
der geöffneten Datei werden entfernt, die Datei
gespeichert und geschlossen.
Du hast ja geschrieben, dass bis zu der Zeile
Workbooks(strDateiName).Close SaveChanges:=True
alles richtig funktioniert. Ich habe im Moment aber keine
Idee, was da nicht stimmen könnte, sorry.
Gruß
stefan
>-----Originalnachricht-----
>Hallo Stefan,
>Danke, aber ich glaub nicht, daß es daran liegt. Vor dem
>ganzen Entfernen von Namen, Formeln, Code etc. wird die
zu
>archivierende Datei (strDateiName) in ein
>Unterverzeichnis "Archiv verschoben". Die Variable
>strDateiName ist an anderer Stelle als Public deklariert
>(wird öfter gebraucht).
>....
> 'Variablen initialisieren
> strPfad = ActiveWorkbook.Path &
Application.PathSeparator
> strDateiNameALT = strPfad & strDateiName
> strDateiNameNEU = strPfad & "Archiv" & _
> Application.PathSeparator & strDateiName
> 'Verschieben in Unterordner Archiv
> Name strDateiNameALT As strDateiNameNEU
> 'Workbook (=WBBetrieb =strDateiNameNEU) öffnen
> Workbooks.Open Filename:=strDateiNameNEU
>....
>.
>
Hans Faber
was ein. Oder jemand anderem. Ich schaue nächstens noch
mal hier rein.
Gruß, Hans
>.
>