Makro Seiten PDF Speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub MakePDFs() On Error GoTo hell Const MyPath As String = "C:\Temp" Const lSpalte As Long = 10 Const lAbZeile As Long = 4 Const BlattQuelle As String = "Blatt 2" Const BlattZiel As String = "Blatt 1" Const ZelleZiel As String = "A1" Const strTerminiere As String = "-" Dim lRow As Long Dim r As Range Dim MyName As String Dim MyPDF As String With Sheets(BlattQuelle) lRow = 53 'Prüft bis Zeile 53 wie verlangt. 'lRow = .Cells(.Rows.Count, lSpalte).End(xlUp).Row 'Alternative: bis letzte beschriebene Zeile prüfen 'Jede Zelle durchgehen For Each r In .Range(.Cells(lAbZeile, lSpalte), .Cells(lRow, lSpalte)) 'Abbruchbedingung If r.Value = strTerminiere Then Exit For Else With Sheets(BlattZiel) 'Wert einsetzen .Range(ZelleZiel).Value = r.Value 'Dateiname der fraglichen PDF definieren MyName = "DerDateiname_" & r.Value MyPDF = MyPath & IIf(VBA.Right(MyPath, 1) = "\", "", "\") & MyName & ".pdf" 'PDF exportieren .ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyPDF, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End With End If Next r End With GoTo heaven: hell: 'Fehler: warscheinlich ungültiges Zeichen im Dateiname. MsgBox "Fehler!" & vbCrLf _ & "Fehlernummer: " & Err.Number & _ vbCrLf & "Fehlerbeschreibung: " & Err.Description heaven: End Sub

Hallo Klaus,
könntest du mir noch mit folgendem Problem helfen. Ich möchte beim o.g. Skript noch, dass vor der Speicherung alle Spalten bei denen die erste Zeile das Symbol "-" hat gelöscht werden. Diese Spalten müssen aber pro Speicherungsvorgang gelöscht werden (können nicht bei der ersten für alle restlichen Speicherungen gelöscht werden).
Für die Löschung habe ich bereits ein Skript:
Range("1:1").Replace "-", "#N/A", xlWhole
Rows(1).SpecialCells(xlCellTypeConstants, 16).EntireColumn.delete
Problem ist, dass ich nicht weiss wo ich diesen Skribt in deinem genau platzieren soll. Denn vor dem Speichern bringt es nichts, denn dann sind diese Spalten schon gelöscht und bei der zweiten Speicherung könnten es andere Spalten sein die gelöscht werden sollten. Mann müsste z.B. vor dem speichern das Tabelleblatt kopieren, die Spalten löschen, dann als PDF speichern und dann das kopierte Tabellenblatt wieder löschen. Dies würde aber die Speicherungszeit pro Datei deutlich erhöhen, weil meine Datei bereits sehr groß ist. Hast du eine Idee? Kannst du mir bitte helfen?
DANKE!

Hallo Claus,
das gehört das zwischen "Wert einsetzen" und "PDF erstellen".
Ich bezweifele aber, dass dein Script das richtige ist. Wie entstehen denn die "-" in Zeile 1? Entstehen sie per Formel, dann zerschießt das "Replace-and-Delete" natürlich alles. Stehen sie bereits fix in den Zellen, gibt es keinen Grund dass pro Vorgang zu machen ... denn dann ändert sich ja nichts :-)
Nach jedem Vorgang zu kopieren halte ich aus Zeitgründen für die falsche Lösung.
Mein Vorschlag: Überprüfe Zeile 1 auf "-" und blende die Spalten aus. In der PDF macht es keinen Unterschied, ob die Spalten gelöscht oder ausgeblendet waren!
Also im Prinzip so: (ungetestet mangels Musterdatei)

[...]
Else
With Sheets(BlattZiel)
'Wert einsetzen
.Range(ZelleZiel).Value = r.Value
       'Spalten mit "-" in Zeile 1 ausblenden
.Cells.EntireColumn.Hidden = False
Dim lCol As Long
Dim rCols As Range
Dim rHide As Range
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each rCols In .Range(.Cells(1, 1), .Cells(1, lCol))
If rCols.Value = "-" Then
If rHide Is Nothing Then
Set rHide = rCols
Else
Set rHide = Union(rHide, rCols)
End If
End If
Next rCols
If Not rHide Is Nothing Then rHide.EntireColumn.Hidden = True
'Dateiname der fraglichen PDF definieren
MyName = "DerDateiname_" & r.Value
MyPDF = MyPath & IIf(VBA.Right(MyPath, 1) = "\", "", "\") & MyName & ".pdf"
'PDF exportieren
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyPDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End With
End If
[...]

Die DIMs kannst du gerne nach oben verschieben, wo sie hingehören. Mit
Application.Screenupdating = False
am Anfang des Makros holst du nochmal mehr Geschwindigkeit raus, aber
Application.Screenupdating = True in der Fehlerbehandlung (direkt unter hell:) nicht vergessen!
Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro Seiten PDF Speichern

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread