Option Explicit

'Schaltfläche (Button) verweist auf dieses Makro

Sub ChkBeforeSave()
Const OrdnerPfad As String = "y:\Nachkalkulation\"     'ggf. ändern
Const PfadZelle As String = "C1"                   '
Const KdNrZelle As String = "E1"                   '
'
Dim flag, chk                                      'alles richtig?
Dim strFullname As String                          'speichern als
'
On Error GoTo Fehler
'Prüfung auf OrdnerPfad in Pfadzelle
With Range(PfadZelle)
   chk = .Value * 1
   If Len(Trim(.Formula)) = 8 Then flag = True
End With
'Prüfung auf Kundennummer in KdNrZelle
With Range(KdNrZelle)
   chk = .Value * 1
   If Len(Trim(.Formula)) <> 5 Then flag = False
End With
On Error GoTo 0
Fehler:
'Auswerten
Select Case Err.Number
   Case 0
      If flag = True Then
         On Error GoTo LW
         Application.DisplayAlerts = False
         strFullname = OrdnerPfad & Format(Range(PfadZelle).Formula, String(8, "0")) & ".xlsx"
         ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
         On Error GoTo 0
      Else
         Call MsgBox("Eingabelängen in " & _
         "PfadZelle" & " bzw. " & "KdNrZelle" & " prüfen!", vbExclamation, "Abbruch")
      End If
   Case 13
      Call MsgBox("Eingaben in " & _
         "PfadZelle" & " bzw. " & "KdNrZelle" & " sind keine Ziffern!", vbExclamation, "Abbruch")
   Case Else
      Call MsgBox("Unbekannter Fehler!", vbExclamation, "Abbruch")
End Select
LW:
If Err.Number = 1004 Then _
   Call MsgBox("Speicherpfad?" & Chr(10) & "Einstellungen im Makro prüfen!", vbExclamation, "Abbruch")
Application.DisplayAlerts = True
End Sub