Hallo VBA-Experten,
ich habe folgendes Problem und bin über jeden Hinweis dankbar. Ich schildere auch meinen Ansatz, mit dem ich jedoch zwei Probleme habe, die ich nicht in den Griff kriege. Auch da bin ich über jeden Hinweis dankbar:
Ausgangslage: Ich habe ein AddIn für Excel 2010 zum Bearbeiten spezieller Exceldateien, also von Exceldateien in einem bestimmten Format. Bearbeitet werden .xlsx-Dateien ohne Makros, und das soll auch so bleiben. Ein generelles Umbenennen z.B. in *.xlsm ist leider nicht möglich.
Problemstellung: Für diese Exceldateien möchte ich gerne eine eigene, besondere "speichern unter"-Routine verwenden, mit eigenem Dialog und co. Dafür gibt es eine eigene SpeichernUnter-Sub. Diese soll die übliche Excel-"Speichern unter"-Funktion ersetzen.
Meine Probleme bei meinem Ansatz:
1.) Beim Schließen eines nicht gespeicherten Workbooks wird richtiger Weise gefragt, ob ich speicher möchte. Drücke ich auf "Ja", wird auch gespeichert, aber anschließend steht die Frage immer noch da. Wie kriege ich die Frage "Möchten Sie vor dem Schließen speichern" denn geschlossen, wenn tatsächlich gespeichert wurde?
2.) Beim Speichern unter funktioniert alles wunderbar. Beim einfachen speichern jedoch wird zuerst gewarnt, dass Makros nicht mitgespeichert werden können, und dann wird erst die Event-Routine BeforeSave abgearbeitet, in der ich Warnungen ausschalte und dafür Sorge, dass gar keine Makros in der Datei sind, wenn sie gespeichert wird. Wie kriege ich diese blöde Meldung weg?
Mein Ansatz im Detail: Im AddIn habe ich eine Anwendungsklasse definiert, die Anwendungs-Events abfängt. Abgefangen wird das WorkbookOpen-Event, welches zunächst prüft, ob eines meiner speziellen Workbooks geöffnet wird, und wenn ja, in diesem Workbook das Event BeforeSave überschreibt.
1 2 3 4 5 6 7 8 9 | Option Explicit
Public WithEvents Anwendung As Application
Private Sub Anwendung_WorkbookOpen( ByVal Wb As Workbook)
If istSpeziellesWorkbook(Wb) Then
SaveAsUeberschreiben Wb
End If
End Sub
|
Die Sub SaveAsUeberschreiben sieht so aus:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | Private Const EreignisSubName As String = "Workbook_BeforeSave"
Public Sub SaveAsUeberschreiben(inWB As Workbook)
Dim iZeile As Long
Dim zAnz As Long
Dim gefunden As Boolean
Dim savedtmp As Boolean
savedtmp = inWB.Saved
With inWB.VBProject.VBComponents( "DieseArbeitsmappe" ).CodeModule
For iZeile = 1 To .CountOfLines
If .ProcOfLine(iZeile, 0) = EreignisSubName Then
gefunden = True
Exit For
End If
Next
If gefunden Then
.DeleteLines .ProcStartLine(EreignisSubName, 0), .ProcCountLines(EreignisSubName, 0)
End If
.InsertLines .CountOfLines + 2, "Private Sub " & EreignisSubName & "(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
.InsertLines .CountOfLines + 1, " Dim AITool As AddIn"
.InsertLines .CountOfLines + 1, " Application.DisplayAlerts = False"
.InsertLines .CountOfLines + 1, " For Each AITool In Application.AddIns"
.InsertLines .CountOfLines + 1, " If istMeinAddIn(AITool) And AITool.Installed Then"
.InsertLines .CountOfLines + 1, " If Application.Run(" "GetVersion" ") >= " "11.5" " Then"
.InsertLines .CountOfLines + 1, " Application.EnableEvents = False"
.InsertLines .CountOfLines + 1, " If SaveAsUI Then"
.InsertLines .CountOfLines + 1, " With ThisWorkbook.VBProject.VBComponents(" "DieseArbeitsmappe" ").CodeModule"
.InsertLines .CountOfLines + 1, " .DeleteLines 1, .CountOfLines"
.InsertLines .CountOfLines + 1, " End With"
.InsertLines .CountOfLines + 1, " Application.Run " "LKFileSaveAs" ""
.InsertLines .CountOfLines + 1, " Else"
.InsertLines .CountOfLines + 1, " With ThisWorkbook.VBProject.VBComponents(" "DieseArbeitsmappe" ").CodeModule"
.InsertLines .CountOfLines + 1, " .DeleteLines 1, .CountOfLines"
.InsertLines .CountOfLines + 1, " End With"
.InsertLines .CountOfLines + 1, " ThisWorkbook.Save"
.InsertLines .CountOfLines + 1, " End If"
.InsertLines .CountOfLines + 1, " Application.Run " "SaveAsUeberschreiben" ", ThisWorkbook"
.InsertLines .CountOfLines + 1, " Cancel = True"
.InsertLines .CountOfLines + 1, " Application.EnableEvents = True"
.InsertLines .CountOfLines + 1, " End If"
.InsertLines .CountOfLines + 1, " Exit For"
.InsertLines .CountOfLines + 1, " End If"
.InsertLines .CountOfLines + 1, " Next AITool"
.InsertLines .CountOfLines + 1, " Application.DisplayAlerts = True"
.InsertLines .CountOfLines + 1, "End Sub"
End With
inWB.Saved = savedtmp
End Sub
|
Hier wird also erst geprüft, ob im Workbook schon eine BeforeSave-Routine existiert. Wenn ja, wird sie gelöscht und dann neu ins Workbook implementiert, wenn nein, wird sie einfach nur neu implementiert. Dabei merke ich mir vorher den Speichern-Status des Workbooks und stelle den nachher wieder her. Das heißt, das Implementieren ändert nichts daran, ob das Workbook als gespeichert gilt oder nicht.
Das funktioniert soweit auch, die BeforeSave-Routine sieht dann so aus:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | Private Sub Workbook_BeforeSave( ByVal SaveAsUI As Boolean , Cancel As Boolean )
Dim AITool As AddIn
Application.DisplayAlerts = False
For Each AITool In Application.AddIns
If istMeinAddIn(AITool) And AITool.Installed Then
If Application.Run( "GetVersion" ) >= "11.5" Then
Application.EnableEvents = False
If SaveAsUI Then
With ThisWorkbook.VBProject.VBComponents( "DieseArbeitsmappe" ).CodeModule
.DeleteLines 1, .CountOfLines
End With
Application.Run "LKFileSaveAs"
Else
With ThisWorkbook.VBProject.VBComponents( "DieseArbeitsmappe" ).CodeModule
.DeleteLines 1, .CountOfLines
End With
ThisWorkbook.Save
End If
Application.Run "SaveAsUeberschreiben" , ThisWorkbook
Cancel = True
Application.EnableEvents = True
End If
Exit For
End If
Next AITool
Application.DisplayAlerts = True
End Sub
|
Es wird erst geprüft, ob die notwendige AddIn-Version installiert ist. Dann werden jeweils alle Codezeilen aus dem Workbook entfernt, weil in .xlsx-Dateien diese ja nicht mitgespeichert werden können. Beim speichern unter wird dann meine eigene Sub im AddIn "LKFileSaveAs" aufgerufen. Das funktioniert auch prima. Beim normalen Speichern wird einfach gespeichert. Anschließend wird die BeforeSave-Event-Routine wieder neu geschrieben.
Wie oben beschrieben bleiben zwei Probleme:
1.) Beim Schließen bleibt auch nach dem Speichern noch die Frage offen, ob ich vor dem Schließen speichern möchte. Wenn ich diese Meldung erst mit speichern quittiere, dann wird gespeichert, die Meldung bleibt. Wenn ich dann abbrechen drücke und direkt nochmal das Workbook schließe, geht es direkt zu. Es ist ja gespeichert. Wie kriege ich diese Meldung weg?
2.) Beim normalen Speichern kommt die Warnung, dass Makros in .xlsx-Dateien nicht mitgespeichert werden können, noch bevor die BeforeSave-Event-Routine abgearbeitet wird. Wie werde ich diese Meldung los?
Vielen Dank für eure Hilfe!
Manatu
|