tweemaal afdrukken, 2e afdruk met "Kopie" als watermerk

[RichieL]

Goedenavond,

Ik heb onderstaande vbascript:
Dit script filtert en waarna hij 2 maal een kopie afdrukt. Dit gaat helemaal goed en werkt dus zonder problemen. Maar ik zou graag de 2e kopie met een "kopie" watermerk oid willen laten printen.

Hoe zou ik dit het beste kunnen doen??

Sub filterinkoop()

    ActiveSheet.Range("$T$3:$Y$9999").AutoFilter Field:=6
    ActiveSheet.Range("$T$3:$Y$9999").AutoFilter Field:=6, Criteria1:="<>0", _
            Operator:=xlOr, Criteria2:="="
            
    sn = Range("z4:z999")                                            'kolom "nodig"
    For i = UBound(sn) To LBound(sn) Step -1                         'zoek laatste cel verschillend van 0
        If sn(i, 1) <> 0 Then Exit For
    Next
    Rij = i + 3                                                      'offset erbij tellen = laatste rij
    Set c = Range("S" & Rij)
    If c.MergeCells = True Then                                      'kijk of overeenkomstige cel in S-kolom een samengevoegde cel is
        Set c0 = c.MergeArea
        Rij = c0.Row + c0.Rows.Count - 1                             'nieuwe laatste rij
    End If

    Range("S4:S" & Rij).Resize(, 7).PrintOut Copies:=2, Collate:=True

End Sub

Bedankt.

 

[edmoor]

Maak een Shape object met het watermerk zoals je deze wilt hebben.
Maak deze onzichtbaar.
Druk het document 1x af.
Maak het object zichtbaar en druk hem nogmaals af.
Maak het object weer onzichtbaar.

 

[RichieL]

Bedankt!

Niet helemaal gelukt met een shapeobject, maar heb t alsvolgt gedaan:

  ActiveSheet.PageSetup.CenterHeader = ""
  Range("S4:S" & Rij).Resize(, 7).PrintOut Copies:=1, Collate:=True           'doe straks die preview weg
  ActiveSheet.PageSetup.CenterHeader = "&36KOPIE!"
  Range("S4:S" & Rij).Resize(, 7).PrintOut Copies:=1, Collate:=True           'doe straks die preview weg
  ActiveSheet.PageSetup.CenterHeader = ""