Benutzer definierte Save (Speichern) Funktion
Heinrich
ich habe folgende Situation:
Ich möchte die Funktion "Speichern" benützen um ein Dokument mit vorgegebenem Pfad und einem Namen, der aus Eintragungen in der Tabelle zusammengesetzt wird, zu speichern.
Die Funktion "Speichern unter" soll nicht verändert werden.
Dazu habe ich mir folgendes Makro geschrieben. Vorweg, das Makro funktioniert mit einer blöden Ausnahme. Diese ist, wenn ein neues Dokument über die Formatvorlage erstellt wird, wird immer der "Speichern unter / Save as" Dialog aufgerufen, da die Variable SaveAsUI automatisch True gesetzt ist. Einmal unter irgendeinem Namen gespeichert funktioniert die Sache.
Sinn der Sache ist natürlich, es sollte auch beim ersten mal funktionieren.
Nun meine Frage. Gibt es eine Möglichkeit die Speichern / Save Funktion für das aktive Workbook generell zu ersetzen, so das Aufrufe von "Speichern" über das Menü oder die Icon Leiste direkt in die Funktion "save_spezial()" geleitet werden?
Ich würde mich über Tipps sehr freuen.
Gruß
Heinrich
------------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Static EventAktiv
If SaveAsUI = True Then Exit Sub ' "Save as" nicht verändern
If Sheets("Daten_Auswahlfelder").Cells(30, 1).Value = 0 Then Exit Sub ' Spezial Behandlung nicht aktiviert
If EventAktiv = True Then Exit Sub ' rekursiver Aufruf der Funktion abfangen
EventAktiv = True
Cancel = True ' Verhindern, daß die Standard Save Funktion nach verlassen dieser Funktion aufgerufen wird
save_spezial ' Eigene Save Funktion aufrufen
EventAktiv = False
End Sub
Sub save_spezial()
Dim Berichtnummer As String, Benennung As String
Dim Teilenummer As String, Speicherpfad As String
Dim Pfad_kpl As String
Berichtnummer = Sheets("Deckblatt").Cells(9, 6).Value
Benennung = Sheets("Deckblatt").Cells(13, 6).Value
Teilenummer = Sheets("Deckblatt").Cells(14, 6).Value
Speicherpfad = Sheets("Daten_Auswahlfelder").Cells(33, 1).Value
Pfad_kpl = Speicherpfad & Berichtnummer & " " & Benennung & " " & Teilenummer
If Berichtnummer = "" Then
MsgBox ("Berichtnummer fehlt")
Exit Sub
End If
If Benennung = "" Then
MsgBox ("Benennung fehlt")
Exit Sub
End If
If Teilenummer = "" Then
MsgBox ("Teilenummer fehlt")
Exit Sub
End If
MsgBox ("Datei wird gespeichert unter " & Pfad_kpl)
On Error Resume Next ' Sollte ein Fehler auftreten, einfach weitermachen (Passiert wenn Datei vorhanden bei Dialog Antwort "Nein")
ActiveWorkbook.SaveAs Filename:=Pfad_kpl, FileFormat:=xlWorkbookNormal
End Sub
------------------------------------------------------