Macro checkLodelStyles()

checkLodelStyles.vb

Private Function styleExists(styleName As String, doc As Document) As Boolean
    Dim MyStyle As Word.Style
    On Error Resume Next
    Set MyStyle = doc.Styles(styleName)
    styleExists = Not MyStyle Is Nothing
End Function

Sub checkLodelStyles()
    Dim erreurStyle As Style
    Dim DocPara As Paragraph
    Dim sty As Style
    Dim mainDoc As Document
    Dim tplDoc As Document

    ' Ouvrir le template en tant que document pour avoir accès aux propriétés et méthodes de l'objet Document
    ' NOTE: On préfère la méthode Documents.Open() à Template.OpenAsDocument() car elle permet de définir .Visible = False
    Set mainDoc = ActiveDocument
    Set tplDoc = Documents.Open(FileName:=mainDoc.AttachedTemplate.FullName, Visible:=False)

    ' Créer un style Erreur dans le document s'il n'existe pas déjà
    If Not styleExists("Erreur", mainDoc) Then
        Set erreurStyle = mainDoc.Styles.Add(Name:="Erreur", _
            Type:=wdStyleTypeParagraph)
    Else
        Set erreurStyle = mainDoc.Styles("Erreur")
    End If
    With erreurStyle.Font
        .Bold = True
        .ColorIndex = wdRed
    End With

    ' Rempacer les styles inconnus par le style Erreur
    For Each DocPara In mainDoc.Paragraphs
        Set sty = DocPara.Range.Style
        If Not (sty Is Nothing) And sty.BuiltIn = False And sty.NameLocal <> "Erreur" And Not styleExists(sty.NameLocal, tplDoc) Then
            DocPara.Range.Style = "Erreur"
        End If
    Next DocPara

    ' Supprimer les styles inconnus
    For Each sty In mainDoc.Styles
        If sty.NameLocal <> "Normal" Then ' Workaround pour un vieux bug de Word : http://shaunakelly.com/word/styles/error-5848-style-definition-is-empty.html
            If sty.BuiltIn = False And sty.NameLocal <> "Erreur" And Not styleExists(sty.NameLocal, tplDoc) Then sty.Delete
        End If
    Next sty

    ' Fermer le template
    tplDoc.Close
End Sub