SIMPLIFICATION MACRO WORD en VBA SVP

Résolu/Fermé

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 - Modifié le 17 janv. 2021 à 18:27
FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 - 20 mai 2021 à 12:19

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

A voir également:

SIMPLIFICATION MACRO WORD en VBA SVP
Supprimer une page word - Guide
Macro word - Guide
Espace insécable word - Guide
Organigramme word - Guide
Word gratuit - Guide

12 réponses

Réponse 1 / 12

jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024 4 650
Modifié le 17 janv. 2021 à 18:36

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

Réponse 2 / 12

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
17 janv. 2021 à 18:49

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

Réponse 3 / 12

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
20 janv. 2021 à 18:18

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

Réponse 4 / 12

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
20 janv. 2021 à 20:08

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.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 12

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
20 janv. 2021 à 20:27

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

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
21 janv. 2021 à 11:27

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

Réponse 6 / 12

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
21 janv. 2021 à 16:35

Au message 2, je t’ai mis un lien vers un tuto pour présenter correctement ton code.

Merci de lire et d’appliquer.

Réponse 7 / 12

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
21 janv. 2021 à 18:32

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

Réponse 8 / 12

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
5 mai 2021 à 09:20

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

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
Modifié le 5 mai 2021 à 19:32

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

Réponse 9 / 12

Utilisateur anonyme
Modifié le 5 mai 2021 à 20:11

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

Réponse 10 / 12

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
6 mai 2021 à 12:49

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

Utilisateur anonyme
6 mai 2021 à 17:55

Avec plaisir !
Bonne continuation.

Réponse 11 / 12

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
7 mai 2021 à 06:48

Bonjour

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

Réponse 12 / 12

FVR812 Messages postés 109 Date d'inscription samedi 10 mai 2008 Statut Membre Dernière intervention 31 mars 2024 2
20 mai 2021 à 12:19

C'est fait ! Merci à tous .

Discussions similaires

Symbole Attention dans Word

Discussions similaires

Newsletters