Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
25.04.2024 09:23:47
Spalten in Kreuztabelle hinzufügen/löschen je nach Vorgabe
25.04.2024 08:41:49
VBA: Probleme mit pdftk zum Zusammenfügen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1744to1748
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1744to1748
1744to1748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Frage ist es möglich...

Frage ist es möglich...
14.03.2020 17:05:31
Ludger
Hallo zusammen,
Habe diesen Code zum erstellen einer PDF Datei eines Tabellenblattes, es klappt auch sehr gut!
Nur ist es so, das ich für einen neuen Monat jedes mal den Ordner per Hand erstellen muss und
diesen dann im Code jedes mal händisch einstellen muss. Meine frage lautet daher ist möglich daher
es automatisch zu machen
.

Sub PDF_Sheet()
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
With wks
.Select
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\März_20\Sonderfahrtabrechnung_  _
" & .Range("G5") & "_" & .Range("G12") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End With
Next wks
Range("B2").Select
Selection.ClearContents
Range("G5:V9").Select
Selection.ClearContents
Range("G12:V16").Select
Selection.ClearContents
Range("I19:L21").Select
Selection.ClearContents
Range("N19:P21").Select
Selection.ClearContents
Range("T19:V21").Select
Selection.ClearContents
Range("N22:N23").Select
Selection.ClearContents
Range("Q24:Q27").Select
Selection.ClearContents
Range("G28:V32").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=12
Range("M36:M41").Select
Selection.ClearContents
Range("B40").Select
Selection.ClearContents
Range("N41").Select
Selection.ClearContents
Range("B5").Select
Sheets("Fahrdaten").Select
'Range("B7").Select
End 


Sub

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage ist es möglich...
14.03.2020 17:07:09
Ludger
Gruß Ludger
hatte ich vergessen
AW: Frage ist es möglich...
14.03.2020 18:52:50
Werner
Hallo,
teste mal: 
Sub PDF_Sheet()
Dim wks As Worksheet, Pfad As String
For Each wks In ActiveWindow.SelectedSheets
With wks
Pfad = "O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\" & _
Format(Date, "MMMM") & "_" & Right(Year(Date), 2)
If Dir(Pfad, vbDirectory) = "" Then
MkDir ("O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\" & _
Format(Date, "MMMM") & "_" & Right(Year(Date), 2))
End If
Pfad = Pfad & "\" & .Range("G5") & "_" & .Range("G12") & ".pdf"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
Next wks
Range("B2").ClearContents
Range("G5:V9").ClearContents
Range("G12:V16").ClearContents
Range("I19:L21").ClearContents
Range("N19:P21").ClearContents
Range("T19:V21").ClearContents
Range("N22:N23").ClearContents
Range("Q24:Q27").ClearContents
Range("G28:V32").ClearContents
Range("M36:M41").ClearContents
Range("B40").ClearContents
Range("N41").ClearContents
End Sub
Es wird aber nur der jeweilige Monatsordner im Ordner 2020 angelegt.
Gruß Werner
Anzeige
AW: Frage ist es möglich...
14.03.2020 22:33:09
Ludger
Hallo Werner,
deine Variante funktioniert ganz gut, nur das er die PDF Datei Sonderfahrtabrechnung_14.03.2020_K.......h.......
in O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\Januar_20 speichert. Und nicht in März_20.
Hab noch nicht raus gefunden warum! Aber vielen Danke für deine Mühe.
Gruß Ludger
AW: Frage ist es möglich...
15.03.2020 06:52:23
Werner
Hallo,
so, jetzt nochmal. Hatte da eh noch Fehler drin. 
Sub PDF_Sheet()
Dim wks As Worksheet, Pfad As String
Dim strName1 As String, strName2 As String
Pfad = "O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\" & _
Format(Date, "MMMM") & "_" & Right(Year(Date), 2)
If Dir(Pfad, vbDirectory) = "" Then
MkDir ("O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\2020\" _
& Format(Date, "MMMM") & "_" & Right(Year(Date), 2))
End If
For Each wks In ActiveWindow.SelectedSheets
With wks
strName1 = "\Sonderfahrtabrechnung_" & .Range("G5")
strName2 = "_" & .Range("G12") & ".pdf"
Pfad = Pfad & strName1 & strName2
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Pfad = Replace(Pfad, strName1 & strName2, "")
End With
Next wks
Range("B2").ClearContents
Range("G5:V9").ClearContents
Range("G12:V16").ClearContents
Range("I19:L21").ClearContents
Range("N19:P21").ClearContents
Range("T19:V21").ClearContents
Range("N22:N23").ClearContents
Range("Q24:Q27").ClearContents
Range("G28:V32").ClearContents
Range("M36:M41").ClearContents
Range("B40").ClearContents
Range("N41").ClearContents
End Sub
Und bei mir werden die PDF-Dateien im richtigen Ordner abgespeichert, egal ob es den Ordner schon gibt, oder ob er durch das Makro erst angelegt werden muss.
Gruß Werner
Anzeige
und hiermit wird auch....
15.03.2020 09:45:10
Werner
Hallo,
der Ordner mit dem entprechenden Jahr angelegt. 
Option Explicit
Sub PDF_Sheet()
Dim wks As Worksheet, Pfad As String, Jahr As String
Dim strName1 As String, strName2 As String
Jahr = Year(Date)
Pfad = "O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\" & Jahr
If Dir(Pfad, vbDirectory) = "" Then
MkDir (Pfad)
End If
Pfad = Pfad & "\" & Format(Date, "MMMM") & "_" & Right(Jahr, 2)
If Dir(Pfad, vbDirectory) = "" Then
MkDir (Pfad)
End If
For Each wks In ActiveWindow.SelectedSheets
With wks
strName1 = "\Sonderfahrtabrechnung_" & .Range("G5")
strName2 = "_" & .Range("G12") & ".pdf"
Pfad = Pfad & strName1 & strName2
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Pfad = Replace(Pfad, strName1 & strName2, "")
End With
Next wks
Range("B2").ClearContents
Range("G5:V9").ClearContents
Range("G12:V16").ClearContents
Range("I19:L21").ClearContents
Range("N19:P21").ClearContents
Range("T19:V21").ClearContents
Range("N22:N23").ClearContents
Range("Q24:Q27").ClearContents
Range("G28:V32").ClearContents
Range("M36:M41").ClearContents
Range("B40").ClearContents
Range("N41").ClearContents
End Sub
Gruß Werner
Anzeige
AW: und hiermit wird auch....
15.03.2020 14:12:29
Ludger
Hallo Werner,
Vielen Dank für deine Mühe, es funktioniert prima!!!
Gruß Ludger
Gerne u. Danke für die Rückmeldung. o.w.T.
15.03.2020 19:50:01
Werner
AW: Frage ist es möglich...
14.03.2020 18:59:36
AlterDresdner
Hallo Ludger,
fast identisch, nur der Ordner 2020 wird auch mit angelegt: 
Sub PDF_Sheet()
Const Verz = "O:\Med.Line_Dokumente\Unterlagen\Sonderfahrten\"
Dim Newdir As String, wks As Worksheet, OldDir As String
OldDir = CurDir
ChDrive Left(Verz, 1)
ChDir Verz
Newdir = Year(Now())
TestMakeDir Newdir
Newdir = Format(Month(Now()), "mmmm") & "_" & Right(Newdir, 2)
TestMakeDir Newdir
For Each wks In ActiveWindow.SelectedSheets
With wks
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CurDir & "\Sonderfahrtabrechnung_" _
& .Range("G5") & "_" & .Range("G12") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End With
Next wks
Range("B2").ClearContents
Range("G5:V9").ClearContents
Range("G12:V16").ClearContents
Range("I19:L21").ClearContents
Range("N19:P21").ClearContents
Range("T19:V21").ClearContents
Range("N22:N23").ClearContents
Range("Q24:Q27").ClearContents
Range("G28:V32").ClearContents
Range("M36:M41").ClearContents
Range("B40").ClearContents
Range("N41").ClearContents
Range("B5").Select
Sheets("Fahrdaten").Select
'Range("B7").Select
ChDrive Left(OldDir, 1)
ChDir OldDir
End Sub
Function TestMakeDir(Newdir)
On Error Resume Next
ChDir Newdir
If Err Then
MkDir Newdir
ChDir Newdir
End If
Err.Clear
End Function

Gruß der AlteDresdner
Anzeige
AW: Frage ist es möglich...
14.03.2020 22:40:27
Ludger
Hallo AlteDresdner,
deine Variante funktioniert ganz gut, er speichert die PDF Datei in den Ordner März wie vorgesehen.
Frage: Wenn der Monat April beginnt wird dann der neue Monat angelegt und die PDF Dateien für den
April darin gespeichert?
Auch dir vielen Dank für deine Mühe.
Gruß Ludger
AW: Frage ist es möglich...
15.03.2020 10:18:17
AlterDresdner
Hallo Ludger,
so ist es gedacht. Das Speicherverzeichnis richtet sich nach dem Datum des Ausführungstages Now().
Gruß der AlteDresdner
AW: Frage ist es möglich...
15.03.2020 13:55:03
Ludger
Hallo AlteDresdner,
Danke die für deine Antwort und Mühe!!!!!
Gruß Ludger
AW: Frage ist es möglich...
15.03.2020 18:13:55
Ludger
Hallo zusammen,
Hab da noch eine Frage zu dem Code?
Ist es auch möglich nicht in PDF sondern auch als .xlsm zu speichern?
Gruß Ludger
Anzeige
AW: Frage ist es möglich...
15.03.2020 20:51:01
AlterDresdner
Hallo Ludger,
1. willst Du jedes Sheet als einzelne Datei speichern?
2. warum .xlsm, liegen da Makros dahinter?
Gruß der AlteDresdner
AW: Frage ist es möglich...
15.03.2020 21:02:44
Ludger
Hallo AlteDresdner,
zu 1. Nein es sollen alle Sheet's gespeichert werden!
zu 2. Ja es sind Makros dahinter?
Gruß Ludger
Rückfrage
15.03.2020 21:58:12
Werner
Hallo,
wie jetzt?
Vorher wolltest du mit dem Code die vorher ausgewählten Tabellenblätter (also mehrere) jeweils jedes Blatt einzeln als PDF-Datei speichern.
Jetzt soll die ganze Datei mit allen Blättern als XLSM gespeichert werden? Dann würde sich aber die Frage stellen: Wozu ein Makro und nicht einfach Datei - Speichern unter....
Oder nicht doch die vorher ausgewählten Tabellenblätter, jeweils jedes Blatt einzeln als XLSM speichern?
Gruß Werner
Anzeige
AW: Rückfrage
16.03.2020 01:19:06
Ludger
Hallo Werner,
Hallo AlteDresdner,
Ab und zu komm ich immer mal wieder auf verrückte Ideen. Aber deine gegen Frage warum ich das machen will, dann muss ich zugeben das du Recht hast mit dem Speichern unter...
Nehme also die Frage zurück!! Bin ja froh das ihr mir bei der PDF Datei sehr geholfen habt.
Danke noch mal an euch beiden.....Und sollte ich mal wieder verrückte Ideen haben melde ich mich wieder.
Gruß an euch beiden.....
Ludger
Gerne. o.w.T.
16.03.2020 07:28:53
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige