VBA Word2007 - Modifier la police selon condition

Sub NameOnglet()
'
'Attribution du nom de chaque feuille

If IsEmpty(Range("B2")) Then Exit Sub
    ActiveSheet.Name = [B2] & " DA"
'    ActiveWorkbook.SaveAs Filename:= _
'        "N:\MDE\DPM\5-Processus Offre de Service-Relation Client\Etudes\Outil pilotage PFS\Documents de travail\Fichiers Jasper DAppels\2012\DA 04.xlsm" _
'        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Sub TriOnglet()
Dim Encore As Boolean
Dim i As Byte
    Do
    Encore = False
    For i = 1 To Sheets.Count - 2
      If Sheets(i).Name > Sheets(i + 1).Name Then
        Sheets(i).Move After:=Sheets(i + 1)
        Encore = True
      End If
    Next i
    Loop Until Encore = False

End Sub

Sub CollMacro()
'
' CollMacro Macro
'
' Collage spécial Htlm
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.Shading.Texture = wdTextureNone
    Selection.Shading.ForegroundPatternColor = wdColorAutomatic
' met un fond vert
    Selection.Shading.BackgroundPatternColor = -704577690
    Selection.Find.ClearFormatting
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.HomeKey Unit:=wdStory
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub CollMacro() 
' Collage spécial Htlm 
    Selection.PasteAndFormat (wdPasteDefault) 
    Selection.Shading.Texture = wdTextureNone 
    Selection.Shading.ForegroundPatternColor = wdColorAutomatic 
' met un fond vert 
    Selection.Shading.BackgroundPatternColor = -704577690 
'MeF des commentaires 
Dim c As Variant 
    Selection.MoveUp Unit:=wdParagraph, Count:=1 
            Selection.Find.ClearFormatting 
For Each c In Paragraph    'je voudrais faire une boucle 
'pour chaque c dans le paragraphe en cours 
If c = "^l'" Or c = "^t'" Then 
'alors sélection de la ligne entière ou mieux jusqu'au prochain ^l 
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend 
    Selection.Font.Size = 9.5 
    Selection.Font.Bold = wdToggle 
    Selection.EndKey Unit:=wdLine     '   arrêt de la sélection 
Next c 
'MeF des paragraphes 
    Selection.Find.ClearFormatting 
    With Selection.ParagraphFormat 
        .SpaceBefore = 0 
        .SpaceAfter = 0 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    With Selection.Find 
        .Text = "^l" 
        .Replacement.Text = "^p" 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    Selection.HomeKey Unit:=wdStory 
    Selection.Find.Execute Replace:=wdReplaceAll 
End Sub

'MeF des commentaires 
Dim c As Variant 
    Selection.MoveUp Unit:=wdParagraph, Count:=1 
            Selection.Find.ClearFormatting 
For Each c In Paragraph    'je voudrais faire une boucle 
'pour chaque c dans le paragraphe en cours 
If c = "^l'" Or c = "^t'" Then 
'alors sélection de la ligne entière ou mieux jusqu'au prochain ^l 
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend 
    Selection.Font.Size = 9.5 
    Selection.Font.Bold = wdToggle 
    Selection.EndKey Unit:=wdLine     '   arrêt de la sélection 
Next c