Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1884to1888
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

speichern NUR unter neuem Namen

speichern NUR unter neuem Namen
10.06.2022 14:42:14
Georg
Hallo ihr Excellianer,
kann ich es in VBA per Makro einrichten, dass sich die Datei, in der das Makro ist, nicht normal speichern lässt, sondern nur (auf gleichem Pfad) mit "speichern unter" ? Das ist doch sicher was mit Workbook_close oder so.. Krieg ich nicht hin und in der Recherche hab ich es auch nicht gefunden. Ist ja sicher nicht schwer, aber zu schwer für mich...
Danke für Eure Hilfe.
Gruß Georg

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: speichern NUR unter neuem Namen
10.06.2022 14:47:13
UweD
Hallo
Ein Tipp
Leg deine Datei doch als
  • Excel-Vorlage mit Makros (*.xltm)

  • ab.
    Dann wird immer eine Kopie generiert...
    LG UweD
    AW: speichern NUR unter neuem Namen
    10.06.2022 14:59:45
    Georg
    Hallo UweD,
    danke, aber da hab ich ein Problem mit.
    1. er speichert es dann irgendwo hin, nicht auf den Pfad, wo die Datei liegt.
    2. Er hängt eine 1 an den bestehenden Namen. Das ist nicht ok. Der Dateiname hat eine bestimmte Logik, in der u.a. das Datum steckt, das es zu ändern gilt.
    3. Er ändert beim Speichern immer wieder den Dateityp zurück..
    Unterm Strich nicht das was ich suche. Aber dennoch nochmal danke für die Idee. Hab wieder was gelernt!
    Gruß Georg
    Anzeige
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:35:34
    UweD
    Hallo nochmal
    da versuch es mal so
    in den Codebeireich von DieseArbeitsmappe
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim FileSaveName As String
    On Error GoTo Fehler
    Cancel = True 'bricht das speichern ab
    FileSaveName = Application.GetSaveAsFilename()
    If FileSaveName  "" And FileSaveName  Me.FullName Then
    Application.EnableEvents = False
    Me.SaveAs FileSaveName
    Else
    MsgBox "Speichern unter diesem Namen nicht erlaubt"
    End If
    Fehler:
    Application.EnableEvents = True
    End Sub
    
    LG UweD
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:46:39
    Georg
    Prima, das kommt dem Gesuchten schon ganz nah! Den Rest schaffe ich. Danke!
    Anzeige
    Danke für die Rückmeldung (mwT)
    10.06.2022 15:51:26
    UweD
    Falls jemand auf Abbrechen drückt....
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim FileSaveName As String
    On Error GoTo Fehler
    Cancel = True 'bricht das speichern ab
    FileSaveName = Application.GetSaveAsFilename()
    If FileSaveName  "Falsch" And FileSaveName  "" Then
    If FileSaveName  Me.FullName Then
    Application.EnableEvents = False
    Me.SaveAs FileSaveName
    Else
    MsgBox "Speichern unter diesem Namen nicht erlaubt"
    End If
    End If
    Fehler:
    Application.EnableEvents = True
    End Sub
    
    LG UweD
    AW: Danke für die Rückmeldung (mwT)
    13.06.2022 10:12:35
    Georg
    Er zeigt mir im "Speichern unter" Fenster immer einen falschen Pfad an. Nicht den, auf dem die urspr. Datei liegt. Wie baue ich das noch ein?
    Anzeige
    noch ne Frage
    13.06.2022 10:14:27
    Georg
    Sorry, Haken zu "Frage noch offen" vergessen
    AW: noch ne Frage
    13.06.2022 12:18:47
    UweD
    Hallo
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim FileSaveName As String, Pfad As String
    On Error GoTo Fehler
    Cancel = True 'bricht das speichern ab
    Pfad = Me.Path
    ChDrive Left(Pfad, InStr(Pfad, ":"))
    ChDir Pfad
    FileSaveName = Application.GetSaveAsFilename()
    If FileSaveName  "Falsch" And FileSaveName  "" Then
    If FileSaveName  Me.FullName Then
    Application.EnableEvents = False
    Me.SaveAs FileSaveName
    Else
    MsgBox "Speichern unter diesem Namen nicht erlaubt"
    End If
    End If
    Fehler:
    Application.EnableEvents = True
    End Sub
    
    LG UweD
    Anzeige
    :-)
    13.06.2022 13:07:38
    Georg
    Klasse, danke Euch beiden. Ich hab es etwas umgebaut und reduziert.
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Dateiname
    Cancel = True
    Application.EnableEvents = False
    Dateiname = ThisWorkbook.Name
    ChDir "C:\..."  ' Wechsel auf akt. Laufwerk
    Application.Dialogs(xlDialogSaveAs).Show (Dateiname)
    Application.EnableEvents = True
    End Sub
    

    AW: speichern NUR unter neuem Namen
    10.06.2022 15:00:42
    Daniel
    Hi
    am einfachsten machst du das über den Datei-Explorer.
    dort die Datei mit der rechten Maustaste anklicken und in den Eigenschaften - Attribute das Häkchen für "Schreibgeschützt" setzen.
    dann wird die Datei immer schreibgeschützt geöffnet (wie eine Vorlage).
    wenn du was an der Datei verändern willst, musst du natürlich den Haken vorher rausnehmen.
    Gruß Daniel
    Anzeige
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:11:03
    Georg
    Hallo Daniel,
    ich hab ständig an der Datei zu tun und muss dort verschiedene Stände ablegen. Ein ständiges rumfummeln im Explorer ist da irgendwie blöd...Aber danke für die Idee!
    Wie gesagt - es gibt doch die Option, dass man beim Öffnen oder schließen einer Datei bestimmte Makros anschiebt. Und da brauche ich es, das es beim Schließen der Datei nicht normal speichert, sondern den "speichern unter" Dialog aufmacht.
    Gruß Georg
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:34:11
    Daniel
    es gibt die Methode
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
    mit der du für eine geöffnete Mappe umstellen kannst, ob sie Schreibgeschützt ist oder nicht.
    das müsstest du im Workbook-Open-Event dann ausführen und vorher abfragen, wer der User ist (Environ("username")).
    Wenn du das bist, lässt du die Datei natürlich so wie sie ist, wenns ein anderer ist, setzt du sie auf ReadOnly.
    zum Unterdrücken der Systemrückfrage gibts die Funktion Application.DisplayAlerts = False
    Gruß Daniel
    Anzeige
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:46:16
    Georg
    Äääähhh - ok - danke. Das krieg ich nicht so hin. UweD hat auch was geschrieben, das scheint mir für mich etwas einfacher - aber dennoch vielen Dank!
    und schönes Wochenende
    Georg
    AW: speichern NUR unter neuem Namen
    10.06.2022 15:57:18
    Daniel
    naja, wenn du den Vorschlag von Uwe hinkriegst, sehe ich keinen Grund, warum du das hier nicht hinbekommen solltest.
    diesen Code im Modul "diese Arbeitsmappe"
    
    Private Sub Workbook_Open()
    If Environ("username")  "Dein Windows-Anmeldename" Then
    Application.DisplayAlerts = False
    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    Application.DisplayAlerts = True
    End If
    End Sub
    
    der bewirkt, dass für alle anderen außer dir die Mappe sofort beim Öffnen auf schreibgeschützt gesetzt wird.
    das hätte den Vorteil, den ich schon beschrieben habe, wenn mit der Mappe arbeiten und neue Stände einspielen willst, musst du nicht warten bis die Kollegen fertig sind, so wie es bei Uwes Idee der fall ist, da er erst beim Speichern eingreift.
    und jetzt erklär mir mal, warum du glaubtest, das nicht hinzubekommen.
    uwes Code sieht doch einiges umfrangreicher aus.
    Gruß Daniel
    Anzeige
    AW: speichern NUR unter neuem Namen
    10.06.2022 16:01:04
    Daniel
    noch ne erweiterung:
    wenn der Kollege die Datei unter einem anderen Namen gespeichert hat, dann sollte sie beim nächsten Öffnen ja nicht schreibgeschützt werden, sondern nur in der Original-Datei.
    das wäre dann so, also Schreibschutz aktivieren, wenn nicht du der Anwender bist und die Mappe das Original ist.
    
    Private Sub Workbook_Open()
    If Environ("username")  "Dein Windows-Anmeldename" And Thisworkbook.Name = "hier der Original-Dateiname.xlsm" Then
    Application.DisplayAlerts = False
    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    Application.DisplayAlerts = True
    End If
    End Sub
    
    Gruß Daniel
    Anzeige
    AW: speichern NUR unter neuem Namen
    13.06.2022 10:19:12
    Georg
    stimmt, sieht doch recht einfach aus. Es baut aber die Rechte beim öffnen um.
    Vielleicht hab ich es falsch beschrieben. Es geht mir gar nicht so sehr um die Bearbeitung durch mehrere User. Nur ich arbeite darin. Es ging mir darum, dass ich gezwungen bin, vor dem Schließen jeweils eine neue Version zu speichern und nicht die alte mit "speichern" zu überschreiben. Ich bitte um Entschuldigung, wenn ich es falsch beschrieben habe. Danke für deine Hilfe!
    Georg
    AW: speichern NUR unter neuem Namen
    13.06.2022 10:59:24
    Daniel
    HI
    ok. jetzt ist es klar.
    die Frage ist, willst du den neuen Dateinamen selber vergeben oder könnte man einfach den neuen Dateinamen berechnen, so dass du einfach nur speichern drücken musst und die Datei wird automatisch mit dem neuen Dateinamen gespeichert.
    Wenn man im Dateinamen Datum und Uhrzeit hat, würde dann jedesmal eine neue Version erstellt werden.
    Dazu im BeforeSave-Event:
    
    Cancel = True
    DateiName = thisworkbook.Path & "\Standardteil des Dateinamens_"
    Dateiname = Dateiname & Format(Now, "YYMMDD_hhmm")
    Application.EnabelEvents = false
    Thisworkbook.Saveas = Dateiname, Fileformat = 50
    Application.EnableEvents = true
    
    damit wird dann bei jedem Speichern automatisch eine neue Version angelegt, über Datum und Uhrzeit wird sichergestellt, dass es immer einen neuen Dateinamen gibt (wenn du sicher gehen willst, nimmst du noch die Sekunden mit dazu)
    das "Cancel = true" verhindert das normale speichern
    das Application.EnabelEvents = False verhindert des Selbstaufruf des BeforeSave-Makros.
    solltest du den Dateinamen mal aus irgendeinem Grund selbst vergeben wollen, aktivierst du in der Menüleiste "Entwickertools" den Entwurfsmodus, dann werden die Eventmakros nicht ausgeführt.
    Gruß Daniel
    Anzeige
    :-)
    13.06.2022 13:07:35
    Georg
    Klasse, danke Euch beiden. Ich hab es etwas umgebaut und reduziert.
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Dateiname
    Cancel = True
    Application.EnableEvents = False
    Dateiname = ThisWorkbook.Name
    ChDir "C:\..."  ' Wechsel auf akt. Laufwerk
    Application.Dialogs(xlDialogSaveAs).Show (Dateiname)
    Application.EnableEvents = True
    End Sub
    

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige