Supportnet Computer
Planet of Tech

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.

'===============================================================
'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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: