SIMPLIFICATION MACRO WORD en VBA SVP

Signaler
Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
-
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
-
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

11 réponses

Messages postés
32342
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
7 mai 2021
3 463
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
 


Cordialement,
Jordane
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
700
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
Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
Ok merci de vos réponses je fais des essais et je reviens vers vous. Bien cordialement.
Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
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.
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
700
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





Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
Merci, j'ai collé dasn code, pour faire un essai sur texte word contenant ces 3 mots, et :

Sub MTCC() >>>> apparait surligné en jaune


Dim lesMots As Variant

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

For Each mot As String In lesMots >>>> apparaît en rouge
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

je suppose qu'il faut corriger quelque chose ? Je rappelle être nul en VBA, merci de continuer à m'aider
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
700
Au message 2, je t’ai mis un lien vers un tuto pour présenter correctement ton code.

Merci de lire et d’appliquer.
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
700
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


Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
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
Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
j'ai oublié ma macro merci d'essayer de me la corriger :
Sub H1()

Dim lesMots 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 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
Messages postés
378
Date d'inscription
samedi 7 novembre 2020
Statut
Membre
Dernière intervention
6 mai 2021
75
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
Messages postés
78
Date d'inscription
samedi 10 mai 2008
Statut
Membre
Dernière intervention
6 mai 2021
2
Je vous remercie, ça fonctionne parfaitement ! Bien cordialement.
Messages postés
378
Date d'inscription
samedi 7 novembre 2020
Statut
Membre
Dernière intervention
6 mai 2021
75
Avec plaisir !
Bonne continuation.
Messages postés
15924
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
7 mai 2021
700
Bonjour

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