Hi Zusammen,
ich finde einfach nicht den fehler, jedesmal wenn ich bei der InputBox auf abrechen klicke kommt Debuggen Fehler
hoffe ihr könnt mir helfen:
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
|