Discussion :

[gloub gloub]

Bonjour le Forum,

Je cherche à faire une macro qui dépasse mes capacités en VBA.
Cette macro est destinée à identifier, dans une to-do list, si un interlocuteur précis est mentionné dans chacun des paragraphes.

Concrètement, ça fonctionnerait comme ça :
1/ l’utilisateur lance la macro
2/ il renseigne dans une fenêtre la chaîne de caractères à identifier dans chaque paragraphe
3/ la macro « scanne » chaque paragraphe.
Si la chaîne est absente, la macro passe au paragraphe suivant
Si la chaîne est présente, la macro insère un point vert (« ■ ») en début de paragraphe, puis passe à la ligne suivante.
4/ et ainsi de suite jusqu’à la fin

Quelqu’un pourrait-il m’aider à faire ça ? (tout ce que je saurais faire par moi-même, c'est le code pour insérer le caractère ■ ).
Merci !

[gloub gloub]

Bon,

Je me suis débrouillé tout seul...mais ça ne marche pas tout à fait.
J'arrive à faire fonctionner une macro mais elle finit par tourner en boucle et insérer des tas de repères avant la dernière occurrence du mot à chercher.

Pour résumer, il faut :
– lancer la macro "TEST"
– quand une fenêtre apparait, taper la chaîne pour laquelle on veut insérer un carré vert en début de ligne (en fait : en début de paragraphe), par exemple taper "vous" (sans les guillemets)
– valider
A ce moment-là, la macro insère des carrés verts au début de chaque ligne qui comporte la chaîne "vous"

C'est magique...sauf que ça beugue à la fin.
Quelqu'un pourrait-il m'aider à comprendre où j'ai faux ?
Merci !

[Invité]

Bonjour,

Il faut tester le résultat de la recherche.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub Test_V2()
 
Dim Paragraphe As Paragraph
Dim Texte_A_Reperer As String
 
    Application.ScreenUpdating = False
 
    ' demande à l'utilisateur le texte à repérer
    Texte_A_Reperer = InputBox("Entrer texte à filtrer :")
 
    'recherche "Texte_A_Reperer" et applique le format "masqué"
    For Each Paragraphe In ActiveDocument.Paragraphs
 
           Paragraphe.Range.Select
 
           With Selection
 
                .Find.ClearFormatting
                .Find.Replacement.ClearFormatting
                .Find.Execute FindText:=Texte_A_Reperer
 
                If .Find.Found = True Then
                    .HomeKey Unit:=wdLine
                    .TypeText Text:="25A0"
                    .ToggleCharacterCode
                    .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    .Font.Size = 14
                    .Font.Color = wdColorGreen
                    .MoveRight Unit:=wdCharacter, Count:=1
                    .TypeText Text:=" "
                    .EndKey Unit:=wdLine
                 End If
            End With
 
    Next Paragraphe
 
    Application.ScreenUpdating = True
 
End Sub

[gloub gloub]

Super, génial, merci !!!!!


Deux questions subsidiaires :

1/ il y a à la fin de mon fichier des paragraphes où, pour gagner du temps dans l'exécution de la macro, je ne souhaite pas faire de recherche.
Ils commencent tous par une date inversée en 6 chiffres (ex : 181201).
Comment faire pour stopper la macro dès qu'elle tombe sur la première chaîne de 6 chiffres ?
Merci !!!

2/ une fois mes repères insérés, j'aurai besoin à un moment de les effacer.
Je pourrai faire une macro simple, mais mon caractère spécial " ■ " n'est pas accepté en VBA.
Comment faire pour effacer tous mes repères d'un coup ?

Merci !!!!

[Invité]

1/ il y a à la fin de mon fichier des paragraphes où, pour gagner du temps dans l'exécution de la macro, je ne souhaite pas faire de recherche.
Ils commencent tous par une date inversée en 6 chiffres (ex : 181201).
Comment faire pour stopper la macro dès qu'elle tombe sur la première chaîne de 6 chiffres ?

Je créerais une fonction basée sur le décompte de 6 chiffres consécutifs dans le range du paragraphe et qui renverrait False ou True.

2/ une fois mes repères insérés, j'aurai besoin à un moment de les effacer.
Je pourrai faire une macro simple, mais mon caractère spécial " ■ " n'est pas accepté en VBA.
Comment faire pour effacer tous mes repères d'un coup ?

Ce code fonctionne mais prend un temps infini.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub SupprimerLesPointsVerts()
 
Dim I As Integer
 
    Application.ScreenUpdating = False
 
    With ActiveDocument
         For I = .Characters.Count To 1 Step -1
           If .Characters(I).Font.Color = wdColorGreen Then .Characters(I).Delete
         Next I
    End With
 
    Application.ScreenUpdating = True
 
 
End Sub

[gloub gloub]

Bonsoir,

Merci beaucoup pour tes réponses.

Je créerais une fonction basée sur le décompte de 6 chiffres consécutifs dans le range du paragraphe et qui renverrait False ou True.

Je vois bien l'idée, mais je ne sais pas comment faire....

Ce code fonctionne mais prend un temps infini.

Je confirme !
Du coup, j'ai eu une idée beaucoup plus rustique : celle de faire un Rechercher tous les "■" verts de 14pts suivis d'un espace, et de les Remplacer par rien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Supprimer_carré()
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(9632) & " "
        .Replacement.Text = ""
        .Forward = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
End Sub

Ça marche très bien et très vite...mais ça efface tous les "■", qu'ils soient verts ou pas.
En effet, avec l'enregistreur de macros, les attributs (police, couleur, souligné, etc...) sont pris en compte dans le Rechercher/Remplacer mais ne sont pas enregistrés...
Là aussi, j'aurais besoin d'un petit coup de main.

Merci !


EDIT 1 :
Bizarrement, cette dernière macro qui a marché sous une forme peut-être un peu différente, beugue à présent sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Text = ChrW(9632) & "_"

J'ai un message d'erreur : 'Erreur de compilation : projet ou bibliothèque introuvable'.

EDIT 2 :
J'ai trouvé une autre parade rustique pour contourner le problème d'effacement de tous les "■" : au lieu d'insérer comme repère seulement un "■" j'insère (puis j'efface une fois que je n'en ai plus besoin) 2 caractères : "■_" dont je suis sûr qu'ils n'apparaissent jamais groupés dans mon texte de base. Reste donc "simplement" à résoudre le bug sur .Text = ChrW(9632)

[Invité]

Pour la suppression du carré vert, une solution plus simple consisterait à générer un signet avec un nom spécifique "CarreVert_1", 2, etc... au moment de la création qu'il suffirait ensuite de détruire.

[Invité]

Je vois bien l'idée, mais je ne sais pas comment faire....

Une piste : Le code ci-dessous sert à identifier les caractères ANSI d'une chaîne. Les chiffres correspondent aux caractères 48 à 57. Il suffirait d'ajouter un Select case pour incrémenter un compteur correspondant aux caractères 48 à 57, et avec un "Case else" de remettre ce compteur à 0. Une fois le nombre 6 atteint de quitter la procédure.

Il faudrait ensuite transformer cette procédure en fonction pour avoir directement le résultat sans passer par une variable publique.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub TesterLesCaracteres()
 
Dim I As Integer, J As Integer
 
    With Selection
         For I = 1 To .Characters.Count
             For J = 0 To 255
                 If Mid(.Range.Text, I, 1) = Chr(J) Then
                    Debug.Print "Caractère " & I & ", valeur : " & Chr(J) & ", code : " & J
                 End If
             Next J
         Next I
    End With
 
End Sub

[gloub gloub]

Merci pour tes réponses.
Pour moi qui connais très peu de VBA et de façon totalement non structurée, c'est un challenge.
Je vais m'y coller quand j'aurai un peu de temps.