Makro ergänzen
10.02.2013 16:39:58
Max
unter Office XP habe ich bisher mit einer Vorlage (xlt) Kundendateien mit folgendem Makro gespeichert:
Private Sub Kunden_Speichern()
Dim Pfad$, Datei$, Filter$, Endg$, File
Pfad = "C:\Kunden\"
Datei = ActiveSheet.Range("I13")
If Datei = "" Then
MsgBox "Ohne Vor- u. Zuname ist kein Speichern möglich", vbExclamation
Exit Sub
End If
If InStr(1, Datei, " ") > 0 Then
Datei = Mid(Datei, InStr(1, Datei, " ") + 1, 99) & ", " & Left(Datei, InStr(1, Datei, " ") - _
1)
End If
Endg = ".xls"
If InStr(Datei, Endg) = 0 Then
Datei = Datei & Endg
End If
Filter = "Excel Files (*" & Endg & "), *" & Endg
File = Application.GetSaveAsFilename(Pfad & Datei, Filter)
If File False Then ActiveWorkbook.SaveAs Filename:=File
End Sub
Da jetzt Office 2010 verwendet wird (Vorlage xltm), soll die Datei mit
den vorhandenen Makros als xlsm gespeichert werden.
Im Internet habe ich dazu ein Makro gefunden (s. unten).
Wie bekommt man aber den Teil aus dem oberen Makro, welcher den Kundennamen dreht,
in das Makro für die xlsm-Version?
Sub Speichernunter()
'Dateinamen vorgeben beim Speichern unter
Dim strVerzeichnis As String
Dim strDateiname As String
strVerzeichnis = "C:\Kunden\"
strDateiname = Application.GetSaveAsFilename(InitialFileName:=strVerzeichnis & _
Range("I13") & " " & Date & ".xlsm", _
FileFilter:="Microsoft Excel-Arbeitsmappe mit Makros (*.xlsm), *.xlsm")
Select Case strDateiname
Case False
Exit Sub
Case Else
ThisWorkbook.SaveAs Filename:=strDateiname , FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Select
End Sub
Es wäre schön, wenn jemand eine Lösung dafür hätte.
Viele Grüsse
Max
Anzeige