AW: Einzelne Tabellenblätter - Speichern unter
31.10.2010 10:42:05
fcs
Hallo Peter,
da gab es ein Mißverständnis in welchen Zellen die Namen der Blätter bzw. Speicherorte stehen.
Hier angepasste Makros mit erweiterter Prüfung des vorgegebenen Dateinamens.
Gruß
Franz
Sub Speichern_MAGvorInb()
Call Speichern(sZelleOrt:="A35", vSheets:="MAGvorInb", lFormat:=51)
End Sub
Sub Speichern_MAGFest()
Call Speichern("A40", "MAGFest", 51)
End Sub
Sub Speichern_MAG_beide()
Call Speichern("A45", Array("MAGFest", "MAGvorInb"), 51)
End Sub
Sub Speichern(sZelleOrt As String, vSheets, Optional lFormat As Long = 51)
'lFormat = Dateiformat unter dem die Datei gespeichert werden soll
'50 = xlsb, 51 = xlsx, 52= xlsm, 56 = xls (Excel8), -4143 = xlWorkbookNormal
Dim Ort As String, vAuswahl As Boolean
Ort = Sheets("Auswahlliste").Range(sZelleOrt)
If CheckDateiName(Ort, Range(sZelleOrt).Row) = True Then
ActiveWorkbook.Sheets(vSheets).Copy
vAuswahl = Application.Dialogs(xlDialogSaveAs).Show(Ort, lFormat)
If vAuswahl = True Then
ActiveWorkbook.Close savechanges:=True
Else
If MsgBox("Blatt bzw. Blätter wurden nicht gespeichert" & vbLf & vbLf _
& "Kopie ohne Speichern schließen?", vbQuestion + vbYesNo, _
"Blätter Kopieren") = vbYes Then
ActiveWorkbook.Close savechanges:=False
End If
End If
End If
End Sub
Function CheckDateiName(sText As String, Optional ByVal lZeile As Long = 0) As Boolean
Dim iIndex As Long, arrZeichen, iZeichen As Long
If sText = "" Then 'Leerstring als Dateiname nicht zulässig
MsgBox ("Ungültiger Dateiname: Die angegebene Zelle ""A" & lZeile _
& """ darf nicht leer sein!")
CheckDateiName = False
Exit Function
End If
'unzulässige Zeichen in Dateinamen
arrZeichen = Array(":", "|", "/", "\", "", "[", "]", "?", "*")
CheckDateiName = True
For iZeichen = 1 To Len(sText)
For iIndex = LBound(arrZeichen) To UBound(arrZeichen)
If Mid(sText, iZeichen, 1) = arrZeichen(iIndex) Then
CheckDateiName = False
MsgBox """" & sText & """" & IIf(lZeile > 0, " in Zelle ""A" & lZeile & """", "") _
& " ist nicht zulässig als Dateiname." & vbLf _
& "Folgende Zeichen sind nicht zulässig: | : / \ [ ] ? * "
Exit Function
End If
Next
Next
End Function