SIMPLIFICATION MACRO WORD en VBA SVP Résolu/Fermé

Question

Bonjour, 



Configuration: Windows / Edge 87.0.664.75
SIMPLIFICATION MACRO WORD en VBA
Bonjour, pour mon travail j’analyse des gros rapports de plusieurs centaines de pages sur des thèmes précis. Je me bricole une macro avec mes mots clés ou racines de mots, pour les afficher sur le texte d’une couleur particulière, et/ou en gras  qui me permet de les repérer plus facilement.
Je fais rechercher/ »mon mot »/remplacer/format/police/couleur/ gras/rouge/remplacer tout/ok ….Ca marche bien. Mais mon problème lorsque j’ai une centaine de mots clés c’est que je dois répéter autant de fois cette enchaînement au risque de me tromper et de me retrouver avec un code en débogage attendu que je suis incapable de gérer ;
Quelqu’un pourrait-il me simplifier cette macro de manière que je puisse écrire la totalité de mes mots clés recherchés les uns à la suite des autres, sur une seule ligne de code et pour qu’ils s’affichent dans une couleur spécifique, et en gras ?
J’avais déjà eu une solution avec constitution d’un USERFORM, mais c’est complexe et je me plante chaque fois. Merci de m’aider à me trouver une macro simplifiée, où je puisse écrire tous mes mots les uns à la suite des autres..
Je vous copie dessous les premières lignes de ma macro MTCC (seulement car elle est interminable avec une centaine de mots recherchés et c'est toujours le même code qui se répète) pour rechercher ici : « conduite », « Comport », « caractère », « fille », « garçon »
Je peux joindre mon fichier word à partir duquel je l’ai construite si besoin
Merci de m’aider.

Sub MTCC()
'
' MTCC Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = "conduite"
        .Replacement.Text = "conduite"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = "Comport"
        .Replacement.Text = "Comport"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = "caractère"
        .Replacement.Text = "caractère"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = "fille"
        .Replacement.Text = "fille"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = "garçon"
        .Replacement.Text = "garçon"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

jordane45 · Answer

Bonjour,

Déjà, au lieu de répéter X fois les mêmes lignes de code, tu pourrais en faire un fonction
et ensuite appeler cette fonction, avec, en argument, le mot cherché
 
Exemple

Sub MTCC()

toto("conduite")
toto("Comport")
'etc...

End Sub

Sub toto(motcherche)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = motcherche
        .Replacement.Text = motcherche
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Utilisateur anonyme · Answer

Bonjour

tout d'abord, pour tes prochains posts, merci de lire attentivement ce petit tuto  https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
Pense aussi à remercier Chris d'avoir rendu ton code plus lisible.

Pour ta question.
Quel que soit le langage si à presque rien près tu écris 2 fois le même code, alors tu dois factoriser.
Factoriser ça veut dire à peu près la même chose qu'en maths => tu regroupes ce qui est commun en une seule fois.

J'ai écrit et souligné "dois", car

c'est du temps de perdu à la rédaction
c'est beaucoup de temps de perdu à la correction/modification (supposons qu'un true doit devenir false ou inversement, en l'état tu le fais 5 fois)
c'est de la place perdue.

La façon de faire est simple, tu écris une sub ou une fonction avec tout le code presque commun, dont les paramètres d'entrée vont te permettre de faire les ajustements pour chaque exécution.

Là, à priori seul le mot recherché change pour un paquet de 16 lignes.
Ce paquet de 16 lignes va donc devenir le corps de notre sub de factorisation et le texte sera donné en paramètre

Sub Remplacer(LeTexte as String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = LeTexte
        .Replacement.Text = LeTexte
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Que tu peux appeler

Remplacer "conduite"
Remplacer "Comport"
'etc

Cela dit avec 100 mots à faire, tu dois quand même appeler la sub 100 fois.
Tu peux donc mettre tes 100 mots dans un tableau et faire une boucle.

Dim lesMots As Variant
    
lesMots = Array("conduite", "Comport", "caractère")

For Each mot As String In lesMots
     Remplacer mot
Next mot

FVR812 · Answer

Ok merci de vos réponses je fais des essais et je reviens vers vous. Bien cordialement.

FVR812 · Answer

Merci mais je suis nul en VBA, tout ce que j'ai fait précédemment c'est enregistrer ma macro, en copier le code et vous l'afficher.

1. Ici, j'ai copié ta macro, pour faire un essai j'ai remplacé text par comport, pour comport=LeTexte 
Est-ce ce que c'est ce qu'il fallait remplacer ?

2. en supposant que ce soit OK j'ai ouvert DEVELOPPEUR, je l'ai collé dasn code mais je ne sais pas comment l'exécuter. 
excuse ma naïveté et mon incompétence, merci de me guider un peu.

Utilisateur anonyme · Answer

Bonsoir

 Ici, j'ai copié ta macro, pour faire un essai j'ai remplacé text par comport, pour comport=LeTexte, nous sommes 2 à t'avoir répondu, je suppose que c'est à moi que tu t'adresses car il n'y a pas de "LeTexte" dans le code de Jordane (que je salue au passage).

Est-ce ce que c'est ce qu'il fallait remplacer ?
non

je l'ai collé dasn code mais je ne sais pas comment l'exécuter.
Certes je n'ai pas été assez explicite, mais Jordane qui à fait à peut près la même chose que moi, l'a été lui en présentant le code d'un seul tenant (ce qui aurait pu t'aiguiller)

Sub MTCC()

Dim lesMots As Variant
    
   lesMots = Array("conduite", "Comport", "caractère")

For Each mot As String In lesMots
        Remplacer mot
   Next mot
End Sub

Sub Remplacer(LeTexte As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = LeTexte
        .Replacement.Text = LeTexte
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Utilisateur anonyme · Answer

Au message 2, je t’ai mis un lien vers un tuto pour présenter correctement ton code.

Merci de lire et d’appliquer.

Utilisateur anonyme · Answer

Essaye comme ça

Sub MTCC()

Dim lesMots As Variant
    
   lesMots = Array("conduite", "Comport", "caractère")

For Each mot In lesMots
        Remplacer (mot)
   Next mot
End Sub 

Tu voies c'est quand même bien plus lisible que ce que tu postes.

Si tu veux que l'on continue à t'aider pense

à nous rendre la lecture agréable
que nous sommes bénévoles et que l'on répond quand on peut et si on veut
que répéter à tout bout de champ que tu es nul en VBA tend à faire penser
que tu penses qu'on ne sait pas lire
que tu as la flemme de lire un cours en ligne sur VBA

FVR812 · Answer

Bonjour, mes excuses pour une absence de plusieurs semaines. Vous m'avez aidé pour mon problème de macro pour mettre en gras rouge des mots clés nombreux recherchés dans un texte. Je reprends votre code dans le texte word (lien joint). Ma macro s'appelle sub H1 (). Elle buggue pour une question de syntaxe. Quelqu'un peut-il me la corriger ? Merci

grosfi.ch/QYdNQdb3dkc

Utilisateur anonyme · Answer

Bonjour,
On peut encore faire mieux pour l'affichage du code. En précisant le langage, on bénéficie de la coloration syntaxique qui permet de mieux lire le code :


Je vous propose l'adapatation ci-dessous.
Notez :
- qu'il manquait un guillemet ouvrant à acces
- qu'il faut déclarer la variable mot comme Variant et en dehors du For Each
- que j'ai ajouté Byval avant Letexte dans la déclaration du Sub sinon, il y avait une erreur de compliation.

Sub H1()
  
  Dim lesMots() As Variant
  Dim mot As Variant
   
  lesMots = Array("handicap", "invalid", "infirm", "dys", "incap", "acces", "autist", "para", "amnésie", _
   "appareil", "besoin", "educ", "particulier", "comport", "discrimin", "emotion", "epiliepsie", "estime", _
   "soi", "person", "représentation", "fonction", "execut", "cognit", "audit", "vis", "situation", "communic", _
   "langage", "corp", "perte", "moteur", "exclu", "retard", "scolaire", "inclus", "parole", "geste", "poly", "pluri", _
   "représent", "sensoriel", "psy", "sentiment", "trouble", "sensibili", "harcel", "potent", "viol", "agress", "atteint", _
   "equite", "egalite", "genre", "intell", "jeu", "ordinaire", "voir", "entendre", "écouter", "sent", "voix", "motricité", _
   "colère", "peur", "joie", "tristesse", "réduit", "mobilité")
  
  For Each mot In lesMots
    Remplacer mot
  Next mot
End Sub

Sub Remplacer(ByVal LeTexte As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = LeTexte
        .Replacement.Text = LeTexte
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

FVR812 · Answer

Je vous remercie, ça fonctionne parfaitement ! Bien cordialement.

Utilisateur anonyme · Answer

Bonjour 

Pense à marquer le sujet résolu avec le bouton adéquat tout en haut du fil

FVR812 · Answer

C'est fait ! Merci à tous .