Makro Seiten PDF Speichern

claus · 2013-08-15T14:06:54+00:00

Hallo, im Tabellenblatt "Blatt 2" befindet sich in einer Spalte (ab Zelle J4) eine Liste mit folgenden Werte (untereinander). "Wert A" "Wert B" "Wert C" "-" "-" usw. Ich möchte gerne per makro, dass der erste Wert der Spalte J (ab J4) der "-" ist(also Wert A) kopiert im Tabellenblatt "Blatt 1" in der Zeile A1, per Inhalte einfügen, einfügt wird und das danach das Tabellenblatt als PDF im Ordner C:\Temp gespeichert wird. Ist dies geschehen, soll das Makro das selbe mit dem nächsten Wert der "-" ist tätigen. Also in diesem Fall "Wert B". Danach mit dem nächsten "Wert C". Da der nächste Wert, in der Spalte, nach "Wert C", ein "-" Symbol ist, soll das Makro stoppen. Also das Makro soll die Spalte von J4 bis J53 überprüfen und nach und nach die o.g. Funktion durchführen. Dies bis sich in der Spalte ein "-" befindet. Vielen Dank! VG Claus

Hallo Claus,
so sollte es gehen:

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

Blattnamen, Zellen, Pfad usw natürlich anpassen.
Grüße,
Klaus M.vdT.

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.

Forumthread: Makro Seiten PDF Speichern

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Makro Seiten PDF Speichern

Forumthread: Makro Seiten PDF Speichern

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread