Word Erreur d'exécution

Sub test_OK()
Dim Chaine$
Chaine = "rapport 16"
 With CreateObject("VBScript.RegExp")
    .Pattern = "(rapport)( )(\d{2})"
    vTest = .test(Chaine)
 End With
 MsgBox vTest
End Sub
Sub test_PASOK()
Dim Chaine$
Chaine = "RAPPORT N°: 3939393"
 With CreateObject("VBScript.RegExp")
    .Pattern = "(rapport)( )(\d{2})"
    vTest = .test(Chaine)
 End With
 MsgBox vTest
End Sub

Sub rapport_provisoire_entete()
Dim Prgrf As Paragraph
Dim reg As New VBScript_RegExp_55.RegExp, Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection
    Set reg = New VBScript_RegExp_55.RegExp
    reg.Pattern = "[^\D]+"
    reg.Global = False
    For Each Prgrf In ThisDocument.Sections(1).Headers(1).Range.Paragraphs
            Set Matches = reg.Execute(Prgrf.Range.Text)
            For Each Match In Matches
                Remplace_dans_Header 1, 1, Match.Value, "PROVISOIRE"
            Next Match
    Next Prgrf
End Sub

Sub Remplace_dans_Header(Sct As Byte, Hdr As Byte, S1 As String, S2 As String)
    With ThisDocument.Sections(Sct).Headers(Hdr).Range.Find
        .Text = S1
        .Forward = False
        .Execute
        If .Found Then .Parent.Text = S2
    End With
End Sub