Automatisch printen in kleur

Sub Afdrukken_water()
' Afdrukken_water Macro'
Dim sht1 As Worksheet, sht2 As Worksheet
Dim rng1 As Range, rng2 As Range
    If MsgBox("U gaat nu de standaardlijsten voor water, installatieplan en toolbox afdrukken!" & vbCr & vbCr _
        & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Afdrukken") = vbCancel Then Exit Sub
    
    Set sht1 = ActiveSheet
    Set sht2 = Sheets("Werkvergunning")
    Set sht3 = Sheets("UITV_wtr")
    Set sht4 = Sheets("TRA")
    sht1.Unprotect
    Set rng1 = Range("C41:L180,C664:L732")
    sht4.Visible = True
    sht3.Visible = True
    sht2.Visible = True

    With sht1
            rng1.PrintOut copies:=1, collate:=True
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    With sht3
            .Range("I9").Value = sht1.Range("E57")
            .PrintOut copies:=1, collate:=True, IgnorePrintAreas:=False
    End With
    End With
sht3.Visible = False
sht1.Select

'Werkvergunning putnr'
sht1.Unprotect
  ar = Cells(24, 24).CurrentRegion
  x = Cells(23, 32)
   If x > 0 Then
    With Sheets("Werkvergunning")
      .Cells(6, 13) = Cells(9, 10)
      For j = 2 To UBound(ar)
        If ar(j, 2) <> "" Then
          .Cells(6, 16) = ar(j, 2)
          .PrintOut , , x
        End If
      Next j
    End With
 End If
sht2.Visible = False
sht1.Select

'TRA afdrukken'
If sht1.Cells(85, 10).Value >= 850 Then sht4.PrintOut copies:=1, collate:=True
sht4.Visible = False
sht1.Select