PDF Dateiname aus Zelle

Question

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

Answer 1

Hi,
ich kann es natürlich nicht mit deinem Pfad testen.
Bei mit funktioniert es mit meinem Pfad:
strPfad = "C:\Users\Mein Name\Desktop\Mappe1.pdf"

Gruß
fedjo

Answer 2

hi fedjo :-)

Vielleicht sind folgende Codes hilfreich fuer deine Ideen !

Gruss Nighty

Exists Ordner > Rückgabewet bei Fund ist True

Function OrdExists(strName As String) As Boolean
On Error Resume Next
ChDir (strName)
If Err = 0 Then OrdExists = True
End Function

Exists Datei > Rückgabewet bei Fund ist True

Function DateiJaNein(Dname As String) As Boolean
On Error GoTo ErrorHandler
If Not Format(FileDateTime(Dname), "ddmmyy") Then
DateiJaNein = True
End If
ErrorHandler:
End Function

Ein Beispiel einer Ordnerauswahl !

Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function

Answer 3

hi fedjo :-)

Wobei du natuerlich auch andere Eigenschaften in den functionen abfragen kannst !
Die hässlichen Fehlerroutinen sind in kleinen gekapselten Functionen erlaubt !
Nicht aber in Hauptmodulen,dort sind sie generell verboten !

Gruss Nighty

Answer 4

hi fedjo :-)

Noch ein filedialog bze Dateiauswahl (Endung txt gegen gewünschte Dateiendung ersetzn oder *.*)

Sub DateiAuswahl()
Dim Auswahl As String
Auswahl = Application.GetOpenFilename("Txt-Dateien (*.txt), *.txt", , "Datei auswählen", , False)
End Sub

Gruss Nighty

Answer 5

Hi Nighty :-)

danke für deine Ideen. Würde sie gern in das Makro einbauen, weiß aber nicht wie/wo...

sorry

Colatrinkerin :-)

Answer 6

hi fedjo und all ^^

Der Code bewirkrt folgendes
Der Zielordner wird auf existens geprueft
Ist er nicht vorhanden wird eine Ordnerauswahl eingeblendet
Folgend wird die Datei auf existens geprüft
Ist sie nicht vorhanden
Wird augehend vom Zielordner eine Dateiauswahl eingeblendet

einzufuegen am Anfang des Makros

Dim strDatei As String

ersetze

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

durch(Pfad und Dateiname in den nächst folgenden 2 zeilen korrigieren)

strPfad = "D:\inst\"
strDatei = "Dummy.pdf"
If OrdExists(strPfad) = False Then strPfad = OrdnerAuswahl
If DateiJaNein(strPfad & strDatei) = False Then
ChDir strPfad
strDatei = Application.GetOpenFilename("Pdf-Dateien (*.Pdf), *.Pdf", , "Datei auswählen", , False)
End If

Die Prüffunktionen !
einzufuegen
alt+11/projektexplorer/AllgemeinesModul

Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function

Function OrdExists(strName As String) As Boolean
On Error Resume Next
ChDir (strName)
If Err = 0 Then OrdExists = True
End Function

[code]Function DateiJaNein(Dname As String) As Boolean
On Error GoTo ErrorHandler
If Not Format(FileDateTime(Dname), "ddmmyy") Then
DateiJaNein = True
End If
ErrorHandler:
End Function[/code

Gruss Nighty

Answer 7

hi all

bei der letzten function die codekennzeichnung am ende wegnehmen
war wohl schiefgelaufen die Kennzeichnung

gruss nighty

Answer 8

hi all ^^

ich nutze Adobe nicht,daher ist fuer micht nichts nachvollziehbar
und kann nur auszugsweise helfen

gruss nighty

Answer 9

hi all ^^

die prüffunktionen sind nur sinnvoll wenn verschiedene rechner genutzt werden oder ordner/Dateinamen nicht eindeutig bekannt sind

gruss nighty

Answer 10

hi all ^^

oder ueberpruefe den pfad nach folgenden muster(besserer ueberblick)

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

gruss nighty