Supportnet / Forum / Tabellenkalkulation
Speichern via VBA
Frage
Hallo zusammen,
in einem Formular habe ich folgende Prozedur eingefügt:
If ActiveWorkbook.Name = "Test.xls" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
ActiveWorkbook.Save
End If
Zudem ist die Datei schreibgeschützt.
Mein Problem: Wird der Name des Programms geändert, wird die 'ActiveWorkbook.Save' ausgeführt. Öffne ich das Programm dann wieder, ist dem doch nicht so. Mir geht es ganz einfach darum, dass das Original (mit welchem Namen auch immer) niemals verändert wird. Will der Anwender die erfassten Daten abspeichern, muss er eine Kopie des Programms unter einem anderen Namen erstellen.
Ich hoffe dass ich mich nicht zu kompliziert ausgedrückt habe. Wäre sehr froh, wenn mir jemand ein paar Tipps geben könnte.
Vielen Danke.
Gruss Rahel
Antwort 1 von coros
Moin Rahel,
habe da mal einen Code, den ich in etwas geänderter Form bei mir einsetze. Nachfolgenden Code kopiere in das VBA Projekt DieseArbeitsmappe, da es sich um ein Workbook_BeforeSave Ereignis handelt.
Bei dem Code wird der Vorlagenname mit dem Namen unter dem die Datei abgespeichert werden soll (Dateiname) verglichen. Wurde als Speichername (Dateiname) der Vorlagenname eingegeben, erscheint ein Fenster mit einem Hinweis und die Datei wird nicht abgespeichert, ansonsten wird die Datei unter dem neuen Namen abgespeichert. Somit wird vermieden, dass die Vorlagendatei überschrieben werden kann. Du musst allerdings noch die Zeile
Const VorlagenName = "Platte:\Verzeichnis\Dateiname.xls"
anpassen.
Der Code wird sicherlich nicht hundertprozentig in Dein Formular passen, da bei mir eine andere Ausgangsituation vorliegt, aber als Lösungsansatz sicherlich verwendbar.
Bei Fragen oder Problemen melde Dich wieder.
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
habe da mal einen Code, den ich in etwas geänderter Form bei mir einsetze. Nachfolgenden Code kopiere in das VBA Projekt DieseArbeitsmappe, da es sich um ein Workbook_BeforeSave Ereignis handelt.
'===============================================================
'Hier wird das Speichern unter dem Vorlagennamen unterbunden.
'===============================================================
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Dim Dateiname, Abfrage As Boolean
Const VorlagenName = "Platte:\Verzeichnis\Dateiname.xls"
Application.DisplayAlerts = True
Abfrage = False
Dateiname = ActiveWorkbook.FullName
Cancel = True
Do
Dateiname = Application.GetSaveAsFilename _
(InitialFileName:="", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Dateiname = False Then Call Tabelle1_aus
If Dateiname = False Then Exit Sub 'Abbruch gedrückt
ok = True
If UCase(Dateiname) = UCase(VorlagenName) Then ok = False: _
MsgBox "Dies ist die Vorlage! Bitte andere Datei wählen!"
Loop Until ok = True
ThisWorkbook.Saved = True
Application.EnableEvents = False
Application.DisplayAlerts = Abfrage
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=Dateiname
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub
Bei dem Code wird der Vorlagenname mit dem Namen unter dem die Datei abgespeichert werden soll (Dateiname) verglichen. Wurde als Speichername (Dateiname) der Vorlagenname eingegeben, erscheint ein Fenster mit einem Hinweis und die Datei wird nicht abgespeichert, ansonsten wird die Datei unter dem neuen Namen abgespeichert. Somit wird vermieden, dass die Vorlagendatei überschrieben werden kann. Du musst allerdings noch die Zeile
Const VorlagenName = "Platte:\Verzeichnis\Dateiname.xls"
anpassen.
Der Code wird sicherlich nicht hundertprozentig in Dein Formular passen, da bei mir eine andere Ausgangsituation vorliegt, aber als Lösungsansatz sicherlich verwendbar.
Bei Fragen oder Problemen melde Dich wieder.
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von Rahel04
Hallo
Danke für Deinen Lösungsansatz. Ehrlich gesagt scheint mir das Ganze trotzdem etwas zu kompliziert. Ich habe (warum bin ich nicht schon früher darauf gekommen???) nun folgendes gemacht:
If MsgBox("Wollen Sie die Eingaben speichern?", vbQuestion + vbYesNo, "Beenden") = vbNo Then
Application.DisplayAlerts = False
ActiveWorkbook.Close
Else
If ActiveWorkbook.ReadOnly Then
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close
Else
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Nimmt der Anwender den Schreibschutz raus, ist er ja wirklich selber schuld.
Danke & Gruss
Rahel
Danke für Deinen Lösungsansatz. Ehrlich gesagt scheint mir das Ganze trotzdem etwas zu kompliziert. Ich habe (warum bin ich nicht schon früher darauf gekommen???) nun folgendes gemacht:
If MsgBox("Wollen Sie die Eingaben speichern?", vbQuestion + vbYesNo, "Beenden") = vbNo Then
Application.DisplayAlerts = False
ActiveWorkbook.Close
Else
If ActiveWorkbook.ReadOnly Then
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close
Else
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Nimmt der Anwender den Schreibschutz raus, ist er ja wirklich selber schuld.
Danke & Gruss
Rahel