Befehl nur einmalig ausführen

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) pw = InputBox("Bitte geben sie Ihr Passwort ein") If Not pw = "8228" Then Cancel = True MsgBox "Sie haben kein oder ein falsche Passwort eingeben" Else Cancel = False With Sheets("Protokoll") Dateiname = .[d10] & Format(.[d8], "_DD.MM.YYYY") & ".xls" End With Application.EnableEvents = False Application.Dialogs(xlDialogSaveAs).Show Dateiname Cancel = True Application.EnableEvents = True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim vTmp vTmp = Split(ThisWorkbook.Name, ".") If Left(vTmp(UBound(vTmp)), 3) "xlt" Then Exit Sub pw = InputBox("Bitte geben sie Ihr Passwort ein") If Not pw = "8228" Then Cancel = True MsgBox "Sie haben kein oder ein falsche Passwort eingeben" Else Cancel = False With ThisWorkbook.Worksheets("Protokoll") Dateiname = .Cells(10, 4) & Format(.Cells(8, 4), "_DD.MM.YYYY") & ".xls" End With Application.EnableEvents = False Application.Dialogs(xlDialogSaveAs).Show Dateiname Cancel = True Application.EnableEvents = True End If End Sub

Danke Rudi,
Mein Alzheimer-Light kommt zurück ;-)
Alles in Allem:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim vtmp, pw As String, DateiName As String
vtmp = Split97(ThisWorkbook.Name, ".")
If Left(vtmp(UBound(vtmp)), 3)  "xlt" Then Exit Sub
pw = InputBox("Bitte geben sie Ihr Passwort ein")
If Not pw = "8228" Then
Cancel = True
MsgBox "Sie haben kein oder ein falsche Passwort eingeben"
Else
Cancel = False
With ThisWorkbook.Worksheets("Protokoll")
DateiName = .Cells(10, 4) & Format(.Cells(8, 4), "_DD.MM.YYYY") & ".xls"
End With
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show DateiName
Cancel = True
Application.EnableEvents = True
End If
End Sub
Function Split97(ByVal Expression As String, _
Optional ByVal Delimiter As String = " ", _
Optional ByVal Limit As Long = -1)
Const cDSize As Long = 256
Dim sArr() As String
Dim lLim As Long
Dim i As Integer, iLastPos As Integer, iPos As Integer, iOffset As Integer
If (Len(Delimiter) = 0) Then
ReDim sArr(0): sArr(0) = Expression
Else
Select Case Limit
Case -1
lLim = 2 ^ 31 - 1
Case Is  0 And i

Gruess Hansueli

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

10 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Befehl nur einmalig ausführen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

10 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread