Introduction de commentaires en VBA

Version imprimable

Bonjour,

je veux analyser le texte d'un fichier Word et introduire des commentaires sur les anomalies trouvées dans le texte.
Pour mettre en place ces analyses il me faut comprendre le mécanisme de marquage, c'est pourquoi j'ai écrit une macro pour tester le processus.
Cette macro fonctionne à peu près correctement mais le commentaire introduit se décale de un caractère sur la gauche à chaque occurrence.
Je ne comprends pas pourquoi. Pourriez-vous m'expliquer où est mon erreur et pourquoi. Merci d'avance.

Je débute en VBA et c'est mon premier message après la présentation, merci d'être indulgent si je ne respecte pas vraiment les règles, ce n'est pas volontaire mais par méconnaissance.

Contenu du fichier Word:
xxx AB1 yy
xxx AB2 yy
xxx AB3 yy
Code:

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 Sub Essai_commenter() Dim objRegex As RegExp Dim matches As MatchCollection Dim fnd As Match Set objRegex = New RegExp Selection.WholeStory With objRegex .Pattern = "AB" .Global = True .MultiLine = True .IgnoreCase = False Set matches = .Execute(Selection.Text) End With With Selection For Each fnd In matches .SetRange Start:=fnd.FirstIndex, _ End:=fnd.FirstIndex + fnd.Length .Select .Comments.Add Range:=Selection.Range, Text:="AB" Next fnd End With Set objRegex = Nothing Set matches = Nothing Set fnd = Nothing End Sub

Citation:

Envoyé par Obelix84

Bonjour,

A chaque fin de paragraphe, vous avez un caractère caché qui n'est pas pris en compte dans l'index. Il faut donc incrémenter de 1 à chaque changement de paragraphe. Le code ci-dessous ne fonctionne pas si vous avez plusieurs occurrences dans le même paragraphe.

Code:

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
 
Sub Essai_commenter()
Dim objRegex As RegExp
Dim matches As MatchCollection
Dim fnd As Match
Dim Incrementation As Integer
 
    Set objRegex = New RegExp
    Selection.WholeStory
    With objRegex
        .Pattern = "AB"
        .Global = True
        '.MultiLine = True
        .IgnoreCase = False
        Set matches = .Execute(Selection.Text)
    End With
 
    Incrementation = 0
    With Selection
        For Each fnd In matches
            .SetRange Start:=fnd.FirstIndex + Incrementation, _
                      End:=fnd.FirstIndex + Incrementation + fnd.Length
            .Select
            .Comments.Add Range:=Selection.Range, Text:="AB"
            Incrementation = Incrementation + 1
        Next fnd
    End With
    Set objRegex = Nothing
    Set matches = Nothing
    Set fnd = Nothing
End Sub

Merci pour cette prompte réponse.

Avec tous les tests que j'avais pu faire, c'est l'explication que j'avais trouvée (plus exactement intuitée!), mais...

A l'origine Essai_commenter (avec cette incrémentation) était appelé depuis une autre procédure et si au premier appel le résultat est correct, au 2eme appel il y a décalage. Dans l'exemple ci-dessous dans la recherche de "CD" le décalage est de 3 caractères (vraisemblablement correspondant aux 3 matchs "AB" précédents). Comment faire pour réinitialiser comme si c'était le premier appel, sans se soucier du nombre matchs précédents dans des appels effectués depuis des sources diverses?

Texte contenu dans le fichier
xxx XY1 yy
xxx XY2 yy
xxx XY3 yy
xxx AB1 yy
xxx AB2 yy
xxx AB3 yy
xxx CD1 yy
xxx CD2 yy
xxx CD3 yy
Code:

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 Sub Chercher_AB_CD() Essai_commenter ("AB") Essai_commenter ("CD") End Sub Sub Essai_commenter(Texte As String) Dim objRegex As RegExp Dim matches As MatchCollection Dim fnd As Match Dim Incrementation As Integer Set objRegex = New RegExp Selection.WholeStory With objRegex .Pattern = Texte .Global = True .IgnoreCase = False Set matches = .Execute(Selection.Text) End With Incrementation = 0 With Selection For Each fnd In matches .SetRange Start:=fnd.FirstIndex + Incrementation, _ End:=fnd.FirstIndex + Incrementation + fnd.Length .Select .Comments.Add Range:=Selection.Range, Text:="AB" Incrementation = Incrementation + 1 Next fnd End With Set objRegex = Nothing Set matches = Nothing Set fnd = Nothing End Sub

Citation:

Envoyé par Obelix84

Une solution consiste à déclarer la variable Incrementation Private ou Public.

Code:

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
 
Option Explicit
 
Private Incrementation As Integer
 
Sub Chercher_AB_CD()
 
    Incrementation = 0
    Essai_commenter "AB", "AB"
    Essai_commenter "CD", "CD"
 
End Sub
 
Sub Essai_commenter(Texte As String, ByVal CommentaireText As String)
Dim objRegex As RegExp
Dim matches As MatchCollection
Dim fnd As Match
 
    Set objRegex = New RegExp
    Selection.WholeStory
    With objRegex
        .Pattern = Texte
        .Global = True
        .IgnoreCase = False
        Set matches = .Execute(Selection.Text)
    End With
 
    With Selection
        For Each fnd In matches
            .SetRange Start:=fnd.FirstIndex + Incrementation, _
                      End:=fnd.FirstIndex + Incrementation + fnd.Length
            .Select
            .Comments.Add Range:=Selection.Range, Text:=CommentaireText
            Incrementation = Incrementation + 1
        Next fnd
    End With
    Set objRegex = Nothing
    Set matches = Nothing
    Set fnd = Nothing
End Sub

Effectivement c'est la solution.

Pour être plus complet sur ma démarche dans ce problème, c'est que j'avais d'abord appliqué cette structure de procédure au surlignage et que tout fonctionnait à merveille! Donc les commentaires et le surlignage ne fonctionnent pas de la même manière...

Cela semblerait vouloir dire que "comment" rajoute un caractère à chaque match, caractère qui n'est pas pris en compte par Regexp. Mais où est ce caractère?
J'ai rajouté (manuellement) du texte entre deux commentaires j'ai même supprimé un commentaire sans que ceux-ci soient décalés.

J'avoue avoir des difficultés à comprendre. Merci pour vos lumières.
Code:

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 Sub Surligner_AB_CD() Essai_surligner ("AB") Essai_surligner ("CD"), Couleur:=wdTurquoise End Sub Sub Essai_surligner(Texte As String, Optional Couleur = wdYellow) Dim objRegex As RegExp Dim matches As MatchCollection Dim fnd As Match Set objRegex = New RegExp Selection.WholeStory With objRegex .Pattern = Texte .Global = True .IgnoreCase = False Set matches = .Execute(Selection.Text) End With With Selection For Each fnd In matches .SetRange Start:=fnd.FirstIndex, _ End:=fnd.FirstIndex + fnd.Length .Select .Range.HighlightColorIndex = Couleur Next fnd End With Set objRegex = Nothing Set matches = Nothing Set fnd = Nothing End Sub
Edit J'ai fait un test avec les commentaires en imbriquant les AB et CD et le résultat n'est pas bon. Je suis vraiment perdu!
xxx XY1 yy
xxx XY2 yy
xxx XY3 yy
xxx AB1 yy
xxx AB2 yy
xxx CD1 yy
xxx CD2 yy
xxx AB3 yy
xxx AB4 yy
xxx CD3 yy
xxx CD4 yy

Citation:

Envoyé par Obelix84

Le principe est de traiter la recherche en une seule passe pour ne plus avoir ce décalage. Le code ci-dessous n'utilise pas votre variable RegExp, mais incrémente la position des différentes chaines dans une variable tableau.

Code:

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
Option Explicit
 
Sub Chercher_AB_CD()
 
Dim ChainesATester As Variant
 
    ChainesATester = Array("AB", "Commentaire AB", "CD", "Commentaire CD")
    Essai_commenter2 ChainesATester
 
End Sub
 
Sub Essai_commenter2(ChainesATester2 As Variant)
 
Dim DocEnCours As Document
Dim I As Integer, J As Integer
Dim MatriceTexte() As Variant
Dim IndexMatrice As Long
Dim CaractereDebut As Long, CaractereFin As Long
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
 
         For I = .Comments.Count To 1 Step -1
             .Comments(I).Delete
         Next I
 
         IndexMatrice = 0
         For I = 1 To .Words.Count
             With .Words(I)
                  For J = LBound(ChainesATester2) To UBound(ChainesATester2) Step 2
 
                      If InStr(1, .Text, ChainesATester2(J), vbTextCompare) > 0 Then
                         .Select
                         With Selection
 
                              .HomeKey Unit:=wdStory, Extend:=wdExtend
                              CaractereDebut = .Characters.Count
                              CaractereFin = .Characters.Count + 2
 
                              ReDim Preserve MatriceTexte(2, IndexMatrice)
                              MatriceTexte(0, IndexMatrice) = CaractereDebut
                              MatriceTexte(1, IndexMatrice) = CaractereFin
                              MatriceTexte(2, IndexMatrice) = ChainesATester2(J + 1)
                              IndexMatrice = IndexMatrice + 1
 
                          End With
                      End If
                Next J
             End With
         Next I
    End With
 
    If IndexMatrice = 0 Then Exit Sub
 
    For IndexMatrice = UBound(MatriceTexte, 2) To LBound(MatriceTexte, 2) Step -1
        DocEnCours.Select
        With Selection
              .SetRange Start:=MatriceTexte(0, IndexMatrice), End:=MatriceTexte(1, IndexMatrice)
              .Select
              .Comments.Add Range:=Selection.Range, Text:=MatriceTexte(2, IndexMatrice)
             ' MsgBox Selection.Range.Text & ", " & MatriceTexte(0, IndexMatrice) & ", " & MatriceTexte(1, IndexMatrice)
        End With
 
    Next IndexMatrice
 
    Set DocEnCours = Nothing
 
End Sub

04/11/2019, 03h07
Obelix84

Merci beaucoup pour cette procédure et le principe qui l'accompagne.

J'ai passé mon dimanche d'abord à la décortiquer pour la comprendre et ensuite à l'adapter pour l'utiliser avec RegExp. J'ai découvert plein de choses! Le résultat est très satisfaisant.

Avant de clôturer la discussion j'ai quelques questions :

1) Pourquoi travailler avec un objet Document local, DocEnCours, plutôt que directement dans ActiveDocument (ligne 21) ?

2) Pourquoi DocEnCours.Select dans la boucle d'affectation des commentaires (ligne 57)

3) Dites-moi si je me trompe: à la place de .Characters.Count (lignes 38 et 39) pour récupérer les positions des chaînes "AB" ou "CD", est-il possible d'utiliser les propriétés .Range.Start et End.
04/11/2019, 04h34
Invité

Citation:

Envoyé par Obelix84

Citation:

1) Pourquoi travailler avec un objet Document local, DocEnCours, plutôt que directement dans ActiveDocument (ligne 21) ?

Il s'agit plutôt d'une habitude de codage utile dans des cas plus complexes mêlant plusieurs documents. Ce n'est pas le cas ici, mais en instanciant vos variables, vous bénéficiez également de l'intellisense, c'est à dire qu'en mettant un point derrière votre variable, vous avez accès à toutes les méthodes et propriétés possibles applicables à l'objet.

Citation:

2) Pourquoi DocEnCours.Select dans la boucle d'affectation des commentaires (ligne 57)

Parce qu'il faut repasser l'objet Selection à l'ensemble du document à chaque itération de la boucle.

Citation:

3) Dites-moi si je me trompe: à la place de .Characters.Count (lignes 38 et 39) pour récupérer les positions des chaînes "AB" ou "CD", est-il possible d'utiliser les propriétés .Range.Start et End.

Oui, c'est .range.end qu'il faut utiliser.
04/11/2019, 10h16
Obelix84

Merci pour votre professionnalisme et votre disponibilité. Je mets cette discussion en résolu et bien sûr je n'oublie pas de voter. :)