Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 10:28:49
16.10.2025 17:40:39
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Workbook_BeforeSave Dateiname aus Zelle

Workbook_BeforeSave Dateiname aus Zelle
12.07.2005 13:19:23
Martin
Hallo Zusammen
Wieder einmal eine Knacknuss (wenigstens für mich).
Wie kann ich dem folgenden Script den Dateinamen der in Zelle "U14" steht in die Dialogbox als vorschlag übergeben?
Mit dem Script

Dim strName As String
strName = Tabelle1.[U14]
Application.Dialogs(145).Show (strName & ".xls")
geht es nicht weil dadurch wiederum eine neue neue Dialogbox geöffnet wird.
********************
&ltpre&gt
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object, BName As String
Dim Kennwort, KWort
Kennwort = "jajaja"
If ThisWorkbook.Sheets.Count &gt 2 Then
For Each sh In ThisWorkbook.Sheets
If sh.Name &lt&gt "Meldeblatt" And sh.Name &lt&gt "Querry" Then BName = "Treffer"
Next sh

If BName = "Treffer" Then
For Each sh In ThisWorkbook.Sheets
If sh.Name &lt&gt "Meldeblatt" And sh.Name &lt&gt "Querry" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Else
MsgBox ("Die Datei enthält mehrere Blätter. " & _
"Es kann jedoch nur ein Blatt gespeichert werden. " & _
"Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _
"den Namen " & Chr$(34) & "Meldeblatt" & Chr$(34) & " geben. Alle anderen Blätter " & _
"werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _
"eine eigene Datei.")

Cancel = True

End If
End If
KWort = InputBox("VB-SCRIPT PROGRAMMING:" & Chr(10) & "DM-Planning-Team" & Chr(10) & Chr(10) & " Durch diese Aktion wird die Datenbankanbindung aus dem File entfernt, " & Chr(10) & " Aktivieren Sie diesen Schritt nur wenn die Erfassung , " & Chr(10) & " abgeschlossen ist und keine Änderungen mehr vorgenommen werden. " & Chr(10) & Chr(10) & "Geben Sie anschliessend bitte das Kennwort ein!")
If KWort &lt&gt Kennwort Then
MsgBox "Sie haben sich entschieden, das die Datei noch weiterbearbeitet wird." & Chr(10) & "Die Datei wird nun gespeigert!"
End
End If
Sheets("Querry").Select

Application.DisplayAlerts = False

With Range("A1:M3")
.QueryTable.Delete
End With
With Range("N1:O40")
.QueryTable.Delete
End With
With Range("P1:T40")
.QueryTable.Delete
End With
Application.DisplayAlerts = True
Sheets("Meldeblatt").Select
Range("A1").Select
End Sub&lt/pre&gt
**********************************
Danke bestens
Gruss
Martin
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Workbook_BeforeSave Dateiname aus Zelle
12.07.2005 17:12:10
Martin
~f~
Hat sich erledigt mit der folgenden Anpassung
Danke trotzdem alle die es versucht haben.
***********************

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object, BName As String
Dim Kennwort, KWort
Dim FilenameU14
Kennwort = "jajaja"
FilenameU14 = Sheets("Meldeblatt").Range("U14")
On Error GoTo Fehler
Application.EnableEvents = True
If ThisWorkbook.Sheets.Count > 2 Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then BName = "Treffer"
Next sh
If BName = "Treffer" Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Else
MsgBox ("Die Datei enthält mehrere Blätter. " & _
"Es kann jedoch nur ein Blatt gespeichert werden. " & _
"Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _
"den Namen " & Chr$(34) & "Meldeblatt" & Chr$(34) & " geben. Alle anderen Blätter " & _
"werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _
"eine eigene Datei.")
Cancel = True
End If
End If
KWort = InputBox("VB-SCRIPT PROGRAMMING:" & Chr(10) & "DM-Planning-Team" & Chr(10) & - Chr(10) & " Durch diese Aktion wird die Datenbankanbindung aus dem File entfernt, " & -Chr(10) & " Aktivieren Sie diesen Schritt nur wenn die Erfassung , " & Chr(10) & - " abgeschlossen ist und keine Änderungen mehr vorgenommen werden. " & Chr(10) & Chr(10) & "Geben Sie anschliessend bitte das Kennwort ein!")
If KWort <> Kennwort Then
MsgBox "Sie haben sich entschieden, das die Datei noch weiterbearbeitet wird." & Chr(10) & "Die Datei wird nun gespeigert!"
'********ab hier die Anpassung
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ("J:\Aktionen\" & FilenameU14)
Cancel = True
Application.EnableEvents = True
'********bis hier
End
End If
'Sheets("Querry").Select
Application.DisplayAlerts = False
With Sheets("Querry").Range("A1:M3")
.QueryTable.Delete
End With
With Sheets("Querry").Range("N1:O40")
.QueryTable.Delete
End With
With Sheets("Querry").Range("P1:T40")
.QueryTable.Delete
End With
Application.DisplayAlerts = True
Sheets("Meldeblatt").Select
Range("A1").Select
'******ab hier die Anpassung
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show ("J:\Aktionen\" & FilenameU14)
Cancel = True
Application.EnableEvents = True
Fehler:
Application.EnableEvents = True
'********bis hier
End Sub

***********************************************
Hoffentlich allen die das selbe Problem hatten geholfen zu haben, dadurch wird die Dialogbox nur noch einmal geöffnet und der Name wird aus einer Zelle generiert.
mit freundlichen Grüssen
Martin
~f~
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige