VBA suppression texte en rouge

Bonjour à tous,

J'essaie de créer une macro sur Word qui permet de supprimer tout le texte qui est en rouge, de mettre le texte en noir et d'enregistrer le fichier au format pdf. La macro permettrait de faire ça sur tous les fichiers d'un dossier.

Pour la partie mettre le texte en noir et enregistrer en pdf ça fonctionne.

Mais je n'arrive pas à supprimer le texte en rouge et ce même en utilisant l'enregistreur de macro.

(Cela peut aussi passer par une mise en forme via un style, si besoin).

Si quelqu'un peut jeter un oeil à mon code, je lui en serai reconnaissant !

Sub WordEnPDF()

    Dim fichier As Object
    Dim chemin As String
    chemin = ThisDocument.Path
    Dim nfichier As String, intpos As Byte
    'pour ouvrir Word car lancée depuis classeur Excel
    Dim objWordApp As Object
    Set objWordApp = CreateObject("Word.Application")
    objWordApp.Application.ChangeFileOpenDirectory chemin
    Dim wd

    Dim dossier As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'identifier le dossier
    Set dossier = Fso.getfolder(chemin)

    Application.ScreenUpdating = False 'pour accélérer l'exécution de la macro, empêche la mise à jour de l'écran
    For Each fichier In dossier.Files 'pour chaque fichier
        If fichier.Path Like "*.docx" Then
            With objWordApp
                .Visible = True
                .Documents.Open fichier.Name
                .Activate
            End With

               'supprimer le texte en rouge
               With Selection.Find
                  .ClearFormatting
                  .Font.ColorIndex = wdRed
                  .Replacement.ClearFormatting
                  .Text = ""
                  .Replacement.Text = ""
                  .Forward = True
                  .Wrap = wdFindContinue
                  .Format = True

               End With
               Selection.Find.Execute Replace:=wdReplaceAll
               Selection.Find.ClearFormatting

             'trouve la position de l'extension, change texte en noir et enregistre en pdf
            intpos = InStrRev(fichier.Name, ".")
            nfichier = Left(fichier.Name, intpos - 1)
            With objWordApp.ActiveDocument
                .Range.Select
                .Range.Font.ColorIndex = wdColorBlack
                .ExportAsFixedFormat OutputFileName:=nfichier, ExportFormat:=17, OpenAfterExport:=False '17 = PDF
                .Close (0) '0 n'enregistre pas les modifs dans docx / -1 enregistre
            End With
        End If
    Next

    objWordApp.Visible = False
    Set objWordApp = Nothing
    Application.ScreenUpdating = True
    MsgBox ("Tous les documents sont enregistrés en pdf.")
End Sub

Merci pour ovtre lecture

Bonjour,

pas vraiment l'habitude sur word mais un essai :

Dim var
For var = 1 To 1000
Selection.WholeStory
With Selection.Find
.Font.ColorIndex = wdRed
.Forward = True
.Execute
If .Found = True Then Selection.Delete
If .Found = False Then Exit Sub
End With
Next var

Bonjour Numéro 2, merci pour ton aide !

Mais je viens à l'instant de réussir. Il fallait que je fasse référence au document ouvert, sinon ça faisait le changement sur le doc contenant la macro et ce malgré "ActiveDocument".

Voici le passage pour la suppression des paragraphes avec un style particulier :

    Dim objWordApp As Object
    Set objWordApp = CreateObject("Word.Application")
    Set Range = objWordApp.ActiveDocument.Content 

    Range.Find.ClearFormatting
    Range.Find.Style = ActiveDocument.Styles("Paragraphe de liste")
    Range.Find.Replacement.ClearFormatting
    With Range.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Range.Find.Execute Replace:=wdReplaceAll

Je commence à comprendre petit à petit le fonctionnement. La persévérance paie