Dateiname automatisch übernehmen aus Zelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Matthias!
Bin mir nicht sicher ob wir dasselbe meinen. Deshalb probiere ich es mal genauer zu erkären.
Ich öffne die Datei 1.xlm
Dann ändere ich mehrere Zellen, unter anderem auch die formatierte um die es mir geht.
In der formartierten Zelle wird nun von mir der Wert 12345 hinterlegt.
Nun möchte ich diese Zelle unter dem Namen 12345.xlm speichern.- Nach Möglichkeit jedoch ohne im Dialogfenster der sich öffnet, etwas zu verändern.
Am besten einfach auf dem Diskettensymbol...
Die zuvor geöffnete Darei 1.xlm sollte in ihren Werten aber nicht verändert sein wenn ich sie das nächste mal öffne...
Hmm... auch irgendwie blöd zu lesen... ich hoffe es ist trotzdem verständlich genug :)
Gruß, Tobias

Hallo Tobias,
teste mal dieses:
in DieseArbeitsmappe:


Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim aw
If ThisWorkbook.Saved Then Exit Sub
aw = MsgBox("Änderungen speichern?", vbYesNoCancel)
Select Case aw
Case vbYes: SpeichernUnter
Case vbNo: ThisWorkbook.Saved = True
Case vbCancel: Cancel = True
End Select
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then MsgBox "Dateiauswahl deaktiviert! Dateiname wird automatisch vergeben."
Cancel = True
SpeichernUnter
End Sub
Private Sub SpeichernUnter()
Application.EnableEvents = False
Application.DisplayAlerts = False
' ###### in der folgenden Zeile wird der Dateiname bestimmt (Tabelle1!A1), b.B. anpassen! ###
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Worksheets("Tabelle1").Range("A1") & ". _
xlm"
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Achtung, durch das Application.DisplayAlerts = False wird die Warnung, dass eine vorhandene Datei überschrieben wird, unterdrückt.
Gruß Matthias

Private Sub SpeichernUnter() Dim fn As String 'Dateiname ermitteln und prüfen: fn = Worksheets("Tabelle1").Range("A1") If Trim(fn) = "" Or _ InStr(fn, ".") > 0 Or _ InStr(fn, "\") > 0 Or _ InStr(fn, "/") > 0 Or _ InStr(fn, " 0 Or _ InStr(fn, ">") > 0 Or _ InStr(fn, "[") > 0 Or _ InStr(fn, "]") > 0 Or _ InStr(fn, ":") > 0 Or _ InStr(fn, "|") > 0 Or _ InStr(fn, "*") > 0 Or _ InStr(fn, "?") > 0 Then MsgBox "Unzulässiger Dateiname!" & vbLf & "Datei wurde nicht gespeichert!", vbCritical Exit Sub End If Application.EnableEvents = False Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & fn & ".xlm" If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler " & Err.Number On Error GoTo 0 Application.DisplayAlerts = True Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Dateiname automatisch übernehmen aus Zelle

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

275 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dateiname automatisch übernehmen aus Zelle

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

275 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread