Discussion :

[oz2007]

Bonjour,

J’ai un gros document word dans lequel j’ai régulièrement des points d’attention (PA) et des écarts fonctionnels (EF) (voir copie d’écran). A la fin du document je souhaite rassembler dans un tableau l’ensemble des PA et des EF (j’ai mis un exemple à la fin du document). Comment puis-je faire pour que mon tableau de synthèse s’implémente automatiquement ? ça m’éviterai de faire pleins de copier/coller avec le risque d’erreur…

Merci d’avance

[oz2007]

dsl est ce ce que je demande est impossible?

[Invité]

Bonjour,

Le code suivant pourrait correspondre à votre demande :

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
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
 
Option Explicit
 
Sub GenerationDesTableauxPAEF()
 
Dim TableEncours As Table
 
Dim NBTablesPA As Long
Dim NBTablesEF As Long
 
Dim CellulePA As Cell
Dim CelluleEF As Cell
 
Dim ContenuCellule As Variant
 
Dim MatricePA() As Variant
Dim MatriceEF() As Variant
 
    With ActiveDocument
 
         ' Balayage 1 : Dimensionnement des matrices PA et EF
         '---------------------------------------------------
         NBTablesPA = 0
         NBTablesEF = 0
         For Each TableEncours In .Tables
             If TableEncours.Rows.Count = 1 Then
                ContenuCellule = Split(TableEncours.Rows(1).Cells(2).Range, Chr(13))
                If Mid(ContenuCellule(0), 19, 2) = "PA" Then NBTablesPA = NBTablesPA + 1
                If Mid(ContenuCellule(0), 19, 2) = "EF" Then NBTablesEF = NBTablesEF + 1
             End If
         Next TableEncours
 
         ReDim MatricePA(NBTablesPA, 1)
         ReDim MatriceEF(NBTablesEF, 1)
 
         ' Balayage 2 : Remplissage des matrices PA et EF
         '-----------------------------------------------
         NBTablesPA = 0
         NBTablesEF = 0
         For Each TableEncours In .Tables
             If TableEncours.Rows.Count = 1 Then
 
                ContenuCellule = Split(TableEncours.Rows(1).Cells(2).Range, Chr(13))
 
                If Mid(ContenuCellule(0), 19, 2) = "PA" Then
                    MatricePA(NBTablesPA, 0) = Mid(ContenuCellule(0), 19, 3)
                    MatricePA(NBTablesPA, 1) = ContenuCellule(1)
                    NBTablesPA = NBTablesPA + 1
                End If
 
                If Mid(ContenuCellule(0), 19, 2) = "EF" Then
                    MatriceEF(NBTablesEF, 0) = Mid(ContenuCellule(0), 19, 3)
                    MatriceEF(NBTablesEF, 1) = ContenuCellule(1)
                    NBTablesEF = NBTablesEF + 1
                End If
             End If
 
         Next TableEncours
 
         ' Création des tables PA et EF
         '-----------------------------
         CreerUneTable UBound(MatricePA, 1), 2, "TableauPA", MatricePA
         CreerUneTable UBound(MatriceEF, 1), 2, "TableauEF", MatriceEF
 
         MsgBox "Fin de mise à jour !" & Chr(10) _
         & UBound(MatricePA, 1) & " enregistrements créés dans la table de synthèse PA" & Chr(10) _
         & UBound(MatriceEF, 1) & " enregistrements créés dans la table de synthèse EF", vbInformation
 
    End With
 
End Sub
 
 
Sub CreerUneTable(ByVal NbLignes As Long, ByVal NbColonnes As Long, ByVal NomSignet As String, ByVal MatriceAssociee As Variant)
 
Dim TableauEncours As Table
 
Dim SignetEnCours As Bookmark
Dim CelluleTableau As Cell
 
    With ActiveDocument
 
        ' Suppression des signets et tables existants
        '--------------------------------------------
        For Each SignetEnCours In .Bookmarks
             If SignetEnCours.Name = NomSignet Then SignetEnCours.Range.Tables(1).Delete
        Next SignetEnCours
 
        ' Positionnement 1 ligne après le signet de synthèse correspondant
        '-----------------------------------------------------------------
        Select Case NomSignet
               Case "TableauPA"
                    Selection.GoTo What:=wdGoToBookmark, Name:="SynthesePA"
                    Selection.MoveDown Unit:=wdLine, Count:=1
               Case "TableauEF"
                    Selection.GoTo What:=wdGoToBookmark, Name:="SyntheseEF"
                    Selection.MoveDown Unit:=wdLine, Count:=1
        End Select
 
        'Création de la table, par défaut 2 lignes
        '-----------------------------------------
        If NbLignes <= 1 Then
            .Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:=NbColonnes, _
            DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
        Else
            .Tables.Add Range:=Selection.Range, NumRows:=NbLignes, NumColumns:=NbColonnes, _
            DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
        End If
 
        ' Recréation du signet
        '---------------------
        With .Bookmarks
             .Add Range:=Selection.Tables(1).Range, Name:=NomSignet
             .DefaultSorting = wdSortByName
             .ShowHidden = False
        End With
 
    End With
 
    ' Remplissage du tableau
    '-----------------------
    Set TableauEncours = Selection.Tables(1)
    With TableauEncours
          .Columns(1).SetWidth ColumnWidth:=76.3, RulerStyle:=wdAdjustNone
          .Columns(2).SetWidth ColumnWidth:=375.65, RulerStyle:=wdAdjustNone
          For Each CelluleTableau In .Columns(1).Cells
                    .Cell(CelluleTableau.RowIndex, 1).Range = MatriceAssociee(CelluleTableau.RowIndex - 1, 0)
                    .Cell(CelluleTableau.RowIndex, 2).Range = MatriceAssociee(CelluleTableau.RowIndex - 1, 1)
                    If CelluleTableau.RowIndex - 1 > UBound(MatriceAssociee, 1) Then Exit Sub
          Next CelluleTableau
    End With
    Set TableauEncours = Nothing
 
End Sub

Ce code est dans le fichier joint : Pièce jointe 223446

Pour le fonctionnement, le fichier Word doit comporter 4 signets :

• SynthesePA englobant les mots "Synthèse PA" dans le document
• SyntheseEF englobant les mots "Synthèse EF"
• TableauPA englobant le tableau de synthèse PA
• TableauEF englobant le tableau de synthèse EF

Les signets "Synthèse PA", "Synthèse EF" servent à positionner les tableaux associés. Les tableaux existants sont détruits et reconstruits à chaque lancement de la macro GenerationDesTableauxPAEF.

Je pense néanmoins que le fonctionnement de ce code reste très aléatoire. Tout repose, en effet, sur le formatage des données de base (chaque enregistrement est un tableau d'une ligne de deux cellules, avec deux retours chariots sur la deuxième cellule). Les matrices recensant les différents cas sont extrêmement dépendantes de la décomposition du contenu de la cellule avec la fonction Split.

Cordialement.

[Invité]

Bonjour,

Avez-vous réglé votre problème ?

Cordialement.