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.
********************
<pre>
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 > 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!"
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</pre>
**********************************
Danke bestens
Gruss
Martin