Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
636to640
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
636to640
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
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

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

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige