Macro werk...maar knop naar macro niet?

Sub Protocol_print(Optional PrPr As String)


Dim rng As Range, cell As Range
 'switch of updating to speed your code & stop irritating flickering
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Protocollen wordt klaargemaakt..."


Worksheets("PROTOCOL N2").Unprotect Password:="secret"
Worksheets("PROTOCOL N3").Unprotect Password:="secret"




If PrPr = "Ma" Then
Set rng = Range("C5:C12")


ElseIf PrPr = "Di" Then
Set rng = Range("C17:C24")


ElseIf PrPr = "Wo" Then
Set rng = Range("C29:C36")


ElseIf PrPr = "Do" Then
Set rng = Range("C41:C48")


ElseIf PrPr = "Vr" Then
Set rng = Range("C53:C60")
End If


For Each cell In rng


If cell.Value = "" Then
Exit For


End If


opleiding = Application.WorksheetFunction.VLookup(cell.Value, Blad2.Range("A3:H147"), 4, False)


If opleiding = "ZWBA" Or opleiding = "ZWBR" Or opleiding = "ZWBB" Then
Worksheets("PROTOCOL N3").Select
Range("ProtoN3_Naam").Value = cell.Value
Range("ProtoN3_OV").Value = Application.WorksheetFunction.VLookup(cell.Value, Blad2.Range("A3:H147"), 2, False)


If opleiding = "ZWBA" Then
Range("ProtoN3_BA").Value = "X"


ElseIf opleiding = "ZWBR" Then
Range("ProtoN3_BR").Value = "X"


ElseIf opleiding = "ZWBB" Then
Range("ProtoN3_BB").Value = "X"


End If


ElseIf opleiding = "UBB" Or opleiding = "UBR" Or opleiding = "UBA" Then
Worksheets("PROTOCOL N2").Select
Range("ProtoN2_Naam").Value = cell.Value
Range("ProtoN2_OV").Value = Application.WorksheetFunction.VLookup(cell.Value, Blad2.Range("A3:H147"), 2, False)


If opleiding = "UBA" Then
Range("ProtoN2_BA").Value = "X"


ElseIf opleiding = "UBR" Then
Range("ProtoN2_BR").Value = "X"


ElseIf opleiding = "UBB" Then
Range("ProtoN2_BB").Value = "X"


End If


End If


  'Printen
        Range("A1:D35").Select
        ActiveSheet.PageSetup.PrintArea = ""
        With ActiveSheet.PageSetup
          .LeftMargin = Application.InchesToPoints(0.6)
          .RightMargin = Application.InchesToPoints(0.4)
          .TopMargin = Application.InchesToPoints(0.75)
          .BottomMargin = Application.InchesToPoints(0.75)
          .HeaderMargin = Application.InchesToPoints(0.3)
          .FooterMargin = Application.InchesToPoints(0.3)
          .PrintHeadings = False
          .PrintGridlines = False
          .PrintComments = xlPrintNoComments
          .PrintQuality = 600
          .CenterHorizontally = False
          .CenterVertically = False
          .Orientation = xlPortrait
          .Draft = False
          .PaperSize = xlPaperA4
          .FirstPageNumber = xlAutomatic
          .Order = xlDownThenOver
          .BlackAndWhite = False
          .Zoom = 85
          .PrintErrors = xlPrintErrorsDisplayed
          .OddAndEvenPagesHeaderFooter = False
          .DifferentFirstPageHeaderFooter = False
          .ScaleWithDocHeaderFooter = True
          .AlignMarginsHeaderFooter = True
            .FitToPagesWide = 1
            .FitToPagesTall = 1
     
        End With
        Selection.PrintOut Copies:=1, Collate:=True
        
Range("ProtoN2_BA, ProtoN2_BR, ProtoN2_BB").Value = ""
Range("ProtoN3_BA, ProtoN3_BR, ProtoN3_BB").Value = ""


Next cell








  
    Application.Cursor = xlDefault
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
   Worksheets("Planning - Praktijk").Activate
   


        
   
   Worksheets("PROTOCOL N2").Protect Password:="secret"
    Worksheets("PROTOCOL N3").Protect Password:="secret"
   
   MsgBox "Protocollen afgedrukt!"
    
  


End Sub

Sub Protocol_maandag()
Dim PrPr As String


PrPr = "Ma"
Protocol_print (PrPr)
     
End Sub


Sub Protocol_dinsdag()
Dim PrPr As String


PrPr = "Di"
Protocol_print (PrPr)
     
End Sub


Sub Protocol_woensdag()
Dim PrPr As String


PrPr = "Wo"
Protocol_print (PrPr)
     
End Sub


Sub Protocol_donderdag()
Dim PrPr As String


PrPr = "Do"
Protocol_print (PrPr)
     
End Sub


Sub Protocol_vrijdag()
Dim PrPr As String


PrPr = "Vr"
Protocol_print (PrPr)
     
End Sub