1.4k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo,
ich verwende den unten stehenden Code und möchte, dass die Datei unter folgendem Namen abgespeichert wird:
Aktionsplanung_Datum_Zelle W3

Wenn ich das Makro ausführe, kommt aber nur:
Aktionsplanung_Datum_ (es fehlt der Zellinhalt W3).

Das Makro wurde zuvor für 3 Tabellenblätter verwendet und muß nun nur noch für 1 Tabellenblatt gelten.

Hat jemand eine Lösung?


Sub PDF_drucken()
'
' PDF_drucken Makro

Dim strPfad As String
Dim lngLetzte As Long

'Pfad und Dateiname für das Blatt Aktionsplanung wurde festgelegt
strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value

'letzte beschriebene Zeile im Tabellenblatt in Spalte A ermitteln
lngLetzte = Worksheets("Aktionsplanung").Cells(Rows.Count, 1).End(xlUp).Row
'ausgefüllter Bereich aus Tabellenblatt wird gedruckt
With Worksheet("Aktionsplanung").Range("A1:W" & lngLetzte)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("W3")
strPfad , Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With


End Sub

21 Antworten

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo,

so klappt der Code bei mir:

Sub PDF_drucken()
'
' PDF_drucken Makro

Dim strPfad As String
Dim lngLetzte As Long

'Pfad und Dateiname für das Blatt Aktionsplanung wurde festgelegt
strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value

'letzte beschriebene Zeile im Tabellenblatt in Spalte A ermitteln
lngLetzte = Worksheets("Aktionsplanung").Cells(Rows.Count, 1).End(xlUp).Row
'ausgefüllter Bereich aus Tabellenblatt wird gedruckt
With Worksheets("Aktionsplanung").Range("A1:W" & lngLetzte)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPfad, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With

End Sub

Und falls immer noch nach dem Datum der Inhalt der Zelle W3, dann überprüf mal, was in der Zelle W3 steht.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.,

ich habe deinen code eingefügt, und er funktioniert :-). Dazu habe ich ein neues Makro erstellt, das vorhandene Makro konnte ich überschreiben, aber W3 wurde nicht im Dateinamen verwendet.

kann ich auch den zellinhalt von 2 zellen als dateinamen verwenden?
Beispiel: Aktionsplanung_Datum_ZelleW3_ZelleW2
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo,

dann ändere die Zeile
strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value

in
strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value & "_" & Worksheets("Aktionsplanung").Range("W2").Value


Gruß

M.O.
0 Punkte
Beantwortet von
fantastisch - vielen Dank :-)
0 Punkte
Beantwortet von
Hi M.O.,

ich würde das Makro gern noch erweitern.
Das gespeicherte PDF soll per e-mail (outlock) an einen festen Empfängerkreis gesendet werden.

Fester Mail-Text Text:
Sehr geehrte Damen und Herren,
anliegend erhalten Sie zu Ihrer Information die geplanten voraussichtlichen Mehrbedarfsmengen für o.g. Aktion.

Mit freundlichen Grüßen,
X.XXX
XXXX

Und einem Betreff:
der aus der Zelle W3 kommt

Kannst Du mir helfen?

Gruß,
Colatrinkerin
0 Punkte
Beantwortet von fedjo Experte (2.2k Punkte)
Hallo Colatrinkerin,
versuch es mal so:

Sub PDF_drucken()
' PDF_drucken Makro
Dim strPfad As String
Dim lngLetzte As Long

'Pfad und Dateiname für das Blatt Aktionsplanung wurde festgelegt
strPfad = strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value & "_" & Worksheets("Aktionsplanung").Range("W2").Value
'letzte beschriebene Zeile im Tabellenblatt in Spalte A ermitteln
lngLetzte = Worksheets("Aktionsplanung").Cells(Rows.Count, 1).End(xlUp).Row
'ausgefüllter Bereich aus Tabellenblatt wird gedruckt
With Worksheets("Aktionsplanung").Range("A1:W" & lngLetzte)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPfad, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Email@freenet.de" 'Deine E-Mail Adresse
.cc = "Email2@t-online.de"
.bcc = "Email3@gmx.de"
.Subject = ActiveSheet.Cells(3, 23).Value
.Body = "Sehr geehrte Damen und Herren," & Chr(13) & _
"anliegend erhalten Sie zu Ihrer Information die geplanten voraussichtlichen Mehrbedarfsmengen für o.g. Aktion." & _
Chr(13) & Chr(13) & Chr(13) & _
"Mit freundlichen Grüßen" & Chr(13) & _
Chr(13) & Chr(13) & _
" X.XXX" & Chr(13) & _
" X.XXX" & _
Chr(13) & Chr(13) & Chr(13)
.Attachments.Add strPfad
.Display
'.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub


Gruß
fedjo
0 Punkte
Beantwortet von
hi fejo,

vielen dank für die Rückmeldung. Ich habe den Code eingefügt und die Anpassungen vorgenommen, aber an dieser Stelle bleibt an das Makro hängen:
.Attachments.Add strPfad

Was kann das sein?

Gruß,
Colatrinkerin
0 Punkte
Beantwortet von
hi :-)

Die Stringzuweisung von strpfad ist nicht korrekt ^^
strPfad = strPfad = ...

Doppelt haelt vielleicht besser .-)
Auf weitere Fehler nicht überprüft !

Gruss Nighty
0 Punkte
Beantwortet von fedjo Experte (2.2k Punkte)
Hi Colatrinkerin ,
Nighty hat da gleich erkannt: strPfad = strPfad =

Gruß
fedjo

Sub PDF_drucken()
' PDF_drucken Makro
Dim strPfad As String
Dim lngLetzte As Long

'Pfad und Dateiname für das Blatt Aktionsplanung wurde festgelegt
strPfad = "G:\Einkauf\Werbung\Aktionsplanungen PDF\Aktionsplanung" & Date & "_" & Worksheets("Aktionsplanung").Range("W3").Value & "_" & Worksheets("Aktionsplanung").Range("W2").Value
'letzte beschriebene Zeile im Tabellenblatt in Spalte A ermitteln
lngLetzte = Worksheets("Aktionsplanung").Cells(Rows.Count, 1).End(xlUp).Row
'ausgefüllter Bereich aus Tabellenblatt wird gedruckt
With Worksheets("Aktionsplanung").Range("A1:W" & lngLetzte)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPfad, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Email@freenet.de" 'Deine E-Mail Adresse
.cc = "Email2@t-online.de"
.bcc = "Email3@gmx.de"
.Subject = ActiveSheet.Cells(3, 23).Value
.Body = "Sehr geehrte Damen und Herren," & Chr(13) & _
"anliegend erhalten Sie zu Ihrer Information die geplanten voraussichtlichen Mehrbedarfsmengen für o.g. Aktion." & _
Chr(13) & Chr(13) & Chr(13) & _
"Mit freundlichen Grüßen" & Chr(13) & _
Chr(13) & Chr(13) & _
" X.XXX" & Chr(13) & _
" X.XXX" & _
Chr(13) & Chr(13) & Chr(13)
.Attachments.Add strPfad
.Display
'.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
0 Punkte
Beantwortet von
Hi,
uups, huch...stimmt, danke. :-)
Aber das Makro bleibt mit folgender Fehlermeldung trotzdem noch hängen:

Laufzeitfehler '-2147024894 (80070002)':
Die Datei kann nicht gefunden werden. Überprüfen Sie den Pfad und den Dateinamen.

.Attachments.Add strPfad

Dateipfad ist in Ordnung.
...