Dateiname automatisch übernehmen aus Zelle

Tobias · 2007-05-26T09:25:49+00:00

Hallo zusammen! Kann mir jemand ob und wie es möglich ist, eine bestimmte Zelle so zu formatieren dass die Nummer die dort eingegeben wird, automatisch als Dateiname übernommen wird wenn ich die Tabelle speicher? (auf Diskettensymbol) Wichtig: Es muss automatisch eine neue Datei angelegt werden, die Änderungen sollen nicht in die Tabelle übernommen werden, die grade bearbeitet wird. Vielen Dank schon mal im voraus!

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

Hallo Tobias,
ich habe die SpeichernUnter-Prozedur noch geändert, damit man keine unerlaubten Zeichen eingeben kann bzw. nicht durch Eingabe von ../../ das Verzeichnis wechseln kann:


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

Gruß Matthias

Dateiname automatisch übernehmen aus Zelle

Forumthread: Dateiname automatisch übernehmen aus Zelle

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Dateiname automatisch aus Zelle übernehmen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Dateiname automatisch übernehmen aus Zelle

Forumthread: Dateiname automatisch übernehmen aus Zelle

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Dateiname automatisch aus Zelle übernehmen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread