Private
Sub
cmdSpeichern_Click()
On
Error
GoTo
Fehler
Dim
strVerzeichnis
As
String
Dim
strDateiname
As
String
strVerzeichnis =
"H:\My Documents\TEST_Speicherort"
strDateiname = ActiveSheet.Range(
"B10"
).Value
Select
Case
strDateiname
Case
""
MsgBox
"Bitte geben Sie ein Aktenzeichen in Zelle B10 ein."
, vbExclamation,
"Datei speichern"
Case
Else
ActiveWorkbook.SaveAs Filename:=strVerzeichnis & strDateiname &
".xls"
, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End
Select
Raus:
Exit
Sub
Fehler:
Select
Case
Err.Number
Case
1004
Resume
Raus
Case
Else
MsgBox
"Fehler: "
&
CStr
(Err.Number) &
" "
& Err.Description, vbCritical,
"cmdSpeichern_Click"
End
Select
Resume
Raus
End
Sub