AW: einzelne Tabelle speichern
12.12.2003 10:46:20
q
Hi Frank,
das Makro in http://www.excel-cd.de/mailing/volumina/031298x.htm kann nicht funktionieren, weil die Variable sFile String enthalt, das nicht als File Name oder File Path verwendet werden kann. Schau mal z.B in Locals Window. Hier ein Versuch das Makro zu verbessern. Falls Fehler auftauchen sollten, lass es mich wissen (q_for_excel@gmx.net)Gruss q.
Option Explicit
Private Const BLATTNAME$ = "Blattname"
Private Const DATEINAME$ = "Dateiname"
Sub BlattSpeichern()
Dim sPath As String, sWks As String, sFile As String
Dim index%
On Error GoTo ErrH
sPath = Application.DefaultFilePath
If (Right(sPath, 1) <> "\") Then sPath = sPath & "\"
sWks = InputBox(prompt:="Blattname", _
Default:=BLATTNAME$)
If ((sWks = "") Or _
(InStr(1, sWks, ":") > 0) Or _
(InStr(1, sWks, "\") > 0) Or _
(InStr(1, sWks, "/") > 0) Or _
(InStr(1, sWks, "?") > 0) Or _
(InStr(1, sWks, "*") > 0) Or _
(InStr(1, sWks, "[") > 0) Or _
(InStr(1, sWks, "]") > 0) Or _
(Len(sWks) > 31)) Then sWks = BLATTNAME$
sFile = InputBox(prompt:="Dateiname", _
Default:=sPath & DATEINAME$ & ".xls")
ActiveSheet.Copy
ActiveSheet.Name = sWks
ActiveWorkbook.SaveAs sFile
MsgBox "Tabelle kopiert als : " & sWks & vbCrLf & _
"In Verzeichniss : " & ActiveWorkbook.Path & vbCrLf & _
"Mit dem Namen : " & ActiveWorkbook.Name, vbInformation
Exit Sub
ErrH:
' falls versucht datei mehrmals mit dem selben namen in den selben verz.
' zu speichern -> exception 1004 -> neue dateineme := dateiname + index% -> neuer versuch datei zu speichern
If (Err.Number = 1004) Then
If (index% < 1000) Then
index% = index% + 1
sFile = sPath & DATEINAME$ & index% & ".xls"
Resume
Else
MsgBox "Variable index% zu Hoch!", vbCritical: End
End If
Else
MsgBox "Laufzeitfehler : " & vbCrLf & Err.Description & vbCrLf & "Fehlernummer : " & Err.Number, vbCritical
End If
End Sub