Makro für Dateiname aus Zellinhalt

Question

Hallo Makro-Profis,

ich habe hier ein Excel-Formular, in dem per Verketten aus einigen Zellen der Dateiname zusammengesetzt wird; beim Speichern wird dann dieser per Makro aus Zelle A1 gelesen in die "Speichern unter"-Dialogbox geschrieben..
Nun kann es Vorkommen, dass in einer Zelle Zeichen stehen, die für einen Dateinamen nicht zulässig sind. Diese Zeichen werden beim Speichern dann von Hand geändert.
Da diese Formulare mehrmals geöffnet, mit Inhalt gefüllt und wieder gespeichert werden, kann es relativ mühsam wenn jedesmal beim speichern die ungültigen Zeichen geändert werden müssen.

Darum wende ich mich nun an euch:

Könnte man ein Makro schreiben, das beim Öffnen der Datei den aktuellen Dateinamen ausliest und genau diesen Dateiname beim Speichern wieder verwendet wird, solange der Inhalt in Zelle A1 nicht geändert wurde?

Vielen Dank für Eure Hilfe!
DasSchaf

Answer 1

Hallo,

geht auch ohne Makro, so

=ZELLE("Dateiname";$A$1)

sonst so

ThisWorkbook.FullName
ActiveWorkbook.FullName

Gruß

Helmut

Answer 2

Hallo,
Beim öffnen der Datei wird A2 gelöscht.
Wenn der Inhalt A1 geändert wird, dann erschein in A2 ein Text.
Beim speichern wird A2 abgefragt ob sie leer ist.
Leer = Dateiname aus A1 sonst ActiveWorkbook.Save

Gruß
fedjo

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then
Cells(2, 1) = "Dateiname" 'Zelle ändern (A2)
End If
End Sub
Sub Speichern()
Application.DisplayAlerts = False
If Sheets("Tabelle1").Range("A1") = "" Then 'Name Tabelle ändern
ActiveWorkbook.Save
Else
ChDir "C:\Dokumente und Einstellungen\" 'Pfad ändern
ActiveWorkbook.SaveAs Filename:=Range("A1").Value, FileFormat:=xlNormal
End If
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
Sheets("Tabelle1").Range("A2").Value = "" 'Zelle wird gelöscht
End Sub

Answer 3

Hallo zusammen,

vielen Dank für Eure Vorschläge; ich war ein paar Tage krank, darum habe ich mich nicht mehr gemeldet.
Im Moment ist in meinem Formular folgendes Makro am Laufen: (habe ich so von meinem Vorgänger übernommen)
Tut mir leid dass ich das nicht schon vorher gepostet habe, im Nachhinein sehe ich dass das wohl einiges vereinfacht hätte.

Die Dialogbox möchte ich gerne behalten, also kein Speichern im Hintergrund. Auch sollten keine Dateipfade vorgegeben werden, weil das Formular je nach Projekt in unterschiedlichen Ordnern abgespeichert wird.
Vielleicht lässt sich das vorhandene Makro ja so abändern in der Art
"beim Speichern Dateiname in Zelle A2 schreiben; beim nächsten Speichern A1 und A2 vergleichen, wenn gleich dann A2 verwenden, wenn nicht gleich dann A1 verwenden"

Hier das bisherige Makro:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim strName As String
strName = ActiveWorkbook.Name

If strName = "Tabelle1.xls" Then
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ThisWorkbook.Path & "\" & Sheets(1).Range("A1")
Application.EnableEvents = True
Else
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ThisWorkbook.Path & "\" & Sheets(1).Range("A1")
Application.EnableEvents = True
End If

End Sub

Answer 4

Hallo zusammen,

ich habe nun ein wenig rumgetüftelt und selber eine Lösung gefunden:

Beim Öffnen der Datei schreibe ich den aktuellen Dateinamen und das Ergebnis der Verkettung in zwei Zellen:

Private Sub Workbook_Open()

Dim OpenName As String
Dim Verkettung As String
OpenName = ActiveWorkbook.Name 'Holt aktuellen Dateinamen
Verkettung = Cells(1, 1) 'holt aktuelles Verkettungs-Ergebnis

Cells(2, 1) = OpenName 'schreibt aktuellen Dateinamen in A2
Cells(3, 1) = Verkettung 'schreibt aktuelles Verkettungs-Ergebnis in A3

End Sub

In A4 vergleiche ich über eine Wenn-Formel die Verkettung beim Öffnen (Zelle A3) mit der Verkettung in A1
Beim Speichern wird A4 abgefragt: falls die Verkettung geändert wurde, wird der Dateiname aus der Verkettung in A1 neu vorgeschlagen, sonst wird der bisherige Dateiname aus A2 verwendet:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


If Cells(4, 1) = 0 Then
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ThisWorkbook.Path & "\" & Sheets(1).Range("A2")
Application.EnableEvents = True
Else
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ThisWorkbook.Path & "\" & Sheets(1).Range("A1")
Application.EnableEvents = True
End If

End Sub

Damit erreiche ich genau das, was ich mir vorgestellt habe.
Und wieder was gelernt...!