Office: Es sollen Spalten als PDF und Mail erstellt werden die ein Bedingung haben

Hallo Ihr Profis,

ich komme nicht weiter und brauch mal eure Hilfe

Ich habe folgende Tabelle

Spalte A (Ja/Nein) Felder, Spalte G bis D sind Adressfelder, J bis M sind Datumfelder.

Bei Spalte A kann ich auswählen ob die Werte der Zeile in ein PDF gespeichert werden, (Ja=PDF erstellen, Nein=kein PDF erstellen)

Mein derzeitiger Code sieht so aus
***************************************************************
Sub DruckenAbfragen()
'Sucht alle Zeilen einer Tabelle, die in Spalte A den Begriff "Ja" enthalten
Dim lngZeile As Long
Dim rngBereich As Range
Dim rngZelle As Range

Set rngBereich = Columns("A").Find("Ja") 'Bitte Suchbegriff "Ja" anpassen !
If Not rngBereich Is Nothing Then
lngZeile = rngBereich.Row
Set rngZelle = rngBereich
Do
Set rngZelle = Columns("A").FindNext(after:=rngZelle)
Set rngBereich = Union(rngBereich, rngZelle)
Loop Until rngZelle.Row <= lngZeile
If MsgBox("Sollen nun folgende " & rngBereich.Rows.Count & _
" Zeile(n)gedruckt werden ?" & vbLf & vbLf & rngBereich.EntireRow.Address, _
vbYesNo + vbQuestion, "Druckbestätigung") = vbYes Then
rngBereich.EntireRow.PrintOut
Else
MsgBox "PDF´s wurden nicht erzeugt!"
End If
Else
MsgBox "Keine entsprechende Zeile gefunden!"
End If

'Speicher für Objektvariablen wieder freigeben
Set rngZelle = Nothing
Set rngBereich = Nothing
End Sub

*******************************************************************
Das blöde ist wenn ein Ja in aufeinander folgenden Zeilen erscheint packt er die auf eine PDF-Seite, die Ja Zeilen die nicht hintereinander kommen erzeugen jeweils ein seperates PDF-Platt. Es soll aber für jedes Ja ein neues PDF erzeugen.

Vielleicht kann mir jemand helfen?

 

Moin Holger,

versuch's mal so:

Code:

Option Explicit

Sub JaDrucken()
Dim i As Integer, r As Integer
r = UsedRange.Rows.Count

For i = 1 To r
    On Error Resume Next
    If Cells(i, 1) = "ja" Then
        Rows(i).Select
        Selection.PrintOut Copies:=1, Collate:=True
    End If
Next i
MsgBox "Done!"
End Sub

Der Code gehört in die Tabelle. Den Aufruf kannst in den Makro-Optionen z.B. auf STRG+j legen.

Grüße