Private
Sub
CommandButton3_Click()
Sheets(
"PRINT"
).
Select
Dim
strDatum
Dim
Register
As
Worksheet
Dim
bolShtVorhanden
As
Boolean
Dim
strNewName
As
String
Dim
bolErsetzen
As
Boolean
Dim
vntAntwort
As
Variant
strDatum = Format(
Date
,
"dd.mm.yyyy"
)
ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
Do
strNewName = InputBox(
"The File will be saved in your current Workbook and today's date: "
& Format(
Date
,
"dd.mm.yyyy"
), , strDatum)
For
Each
Register
In
ActiveWorkbook.Sheets
If
Register.Name = strNewName
Then
bolShtVorhanden =
True
vntAntwort = MsgBox(
"The file already exists.,"
& vbCrLf _
&
"Do you want to overwrite it?"
, _
vbQuestion + vbYesNo,
"Security check"
)
If
vntAntwort = vbYes
Then
bolErsetzen =
True
Exit
Do
End
If
End
If
Next
Register
If
Not
bolShtVorhanden
Then
Exit
Do
Loop
If
bolErsetzen
Then
On
Error
Resume
Next
With
Application
.ScreenUpdating =
False
.DisplayAlerts =
False
Sheets.Delete
.DisplayAlerts =
True
.ScreenUpdating =
True
End
With
End
If
ActiveSheet.Name = strNewName
Range(
"A1"
).
Select
Sheets(
"Welcome"
).
Select
MsgBox
"Saved!"
End
Sub