Unter 2 Verschiedene Pfade Speichern
05.03.2008 14:58:00
Heinz
Habe unteres Makro zum speichern unter den Namen von D8 im selben Ordner.
Nun würde ich aber wenn in D8 eine 5 stellige Zahl ist,das speichern unter
C:\Dokumente und Einstellungen\Heinz\Desktop\Packanweisung
Zb. in D8 steht 12345 dann würde es unter C:\Dokumente und Einstellungen\Holzmann Heinz\Desktop\Packanweisung
gespeichert gehören.
Wenn in D8 12345-Vorschlag steht würde es unter
C:\Dokumente und Einstellungen\Heinz\Desktop\Packanweisung\Vorschlag
gespeichert gehören.
Könnte mir bitte dazu jemand weiterhelfen.
Danke & Gruß Heinz
Sub Speichern()
Dim wsVorschlag As Worksheet, wbThis As Workbook
Dim wsKopie As Worksheet, wbNeu As Workbook, strName As String
Set wbThis = ThisWorkbook
Set wsVorschlag = wbThis.Worksheets("Vorschlag")
strName = wsVorschlag.Range("D8").Text
If strName = "" Then
If MsgBox("In Zelle D8 steht nichts drin. Trotzdem Blatt Vorschlag speichern?", _
vbQuestion + vbYesNo, "Blatt Vorschlag speichern") = vbNo Then GoTo Ende
End If
'Blatt kopieren
wsVorschlag.Copy
Set wbNeu = ActiveWorkbook
Set wsKopie = wbNeu.Worksheets(1)
wsKopie.Shapes("Schaltfläche 1").Delete
'Blatt umbenennen
If strName "" Then wsKopie.Name = strName
'Blattname prüfen und ggf. Name für Datei anpassen
If wsKopie.Name = "Vorschlag" Then strName = "Vorschlag" & _
Format(Now, "YYYYMMDD_hhmmss")
'Datei speichern
wbNeu.SaveAs Filename:=wbThis.Path & "\" & strName & ".xls", Addtomru:=True
wbNeu.Close
Ende:
Set wsVorschlag = Nothing: Set wbThis = Nothing
Set wsKopie = Nothing: Set wbNeu = Nothing
End Sub