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.

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:

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
        ' Feststellen, ob Überschreibung schon implementiert
        For iZeile = 1 To .CountOfLines
            If .ProcOfLine(iZeile, 0) = EreignisSubName Then ' 0 = vbext_pk_Proc
                gefunden = True
                Exit For
            End If
        Next
        ' Wenn gefunden, dann löschen ...
        If gefunden Then
            .DeleteLines .ProcStartLine(EreignisSubName, 0), .ProcCountLines(EreignisSubName, 0) ' 0 = vbext_pk_Proc
        End If
        ' ... neu implementieren
        .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:

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