Discussion :

[tom0ne]

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
Function TableauBorduresV(ByVal TableEnCours2 As Table, ByVal CouleurIndexTitre As Integer) As Boolean
 
Dim I As Integer, J As Integer, ColonneTitre As Integer, NbColonnes As Integer
 
     TableauBorduresV = False
 
     With TableEnCours2.Rows(1).Range
          NbColonnes = .Cells.Count
          ColonneTitre = 0
          For J = 1 To NbColonnes
              If .Borders(wdBorderRight).LineStyle <> wdLineStyleNone
          Next J
     End With
 
     If ColonneTitre < NbColonnes Then TableauBorduresV = True
 
End Function

What's wrong? Eric

[Invité]

La fonction aurait donné cela :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
 
Function TableauBorduresV(ByVal TableEnCours2 As Table, ByVal ColonneATester As Integer) As Boolean
 
     TableauBorduresV = False
     With TableEnCours2.Columns(ColonneATester).Cells
          If .Borders(wdBorderRight).LineStyle <> wdLineStyleNone Then
             TableauBorduresV = True
          End If
     End With
 
End Function

Cette fonction pourrait directement mettre en couleur la bordure de la colonne le cas échéant.

Le code modifié ne contient cette fonction mais elle est remplacée par la procédure MefBorduresInterieuresVerticales. La procédure MiseEnFormeDesBordures ne traite que les bordures extérieures et horizontales.

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
 
Option Explicit
 
 
Sub Test()
 
Dim DocEnCours As Document
Dim I As Integer, J As Integer, ColonneEncours As Integer, CouleurTitre As Integer, NouvelleCouleurDeFond As Integer
Dim TableEnCours As Table
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
         CouleurTitre = wdGray25
         NouvelleCouleurDeFond = wdRed
         For I = 1 To .Tables.Count
             Set TableEnCours = .Tables(I)
             With TableEnCours.Range
                  Select Case TableauPartiel(TableEnCours, CouleurTitre)
                         Case True
                              For J = 1 To .Cells.Count
                                  With .Cells(J)
                                       ColonneEncours = .ColumnIndex
                                       If .Shading.BackgroundPatternColorIndex = CouleurTitre Then
                                          .Shading.BackgroundPatternColorIndex = NouvelleCouleurDeFond
                                          TableEnCours.Columns(ColonneEncours).Select
                                          MiseEnFormeDesBordures Selection
                                       End If
                                   End With
 
                              Next J
 
                         Case Else
 
                              TableEnCours.Rows(1).Cells.Shading.BackgroundPatternColorIndex = NouvelleCouleurDeFond
                              TableEnCours.Select
                              MiseEnFormeDesBordures Selection
                              MefBorduresInterieuresVerticales Selection
 
                  End Select
             End With
             Set TableEnCours = Nothing
         Next I
    End With
    Set DocEnCours = Nothing
 
End Sub
 
Function TableauPartiel(ByVal TableEnCours2 As Table, ByVal CouleurIndexTitre As Integer) As Boolean
 
Dim I As Integer, J As Integer, ColonneTitre As Integer, NbColonnes As Integer
 
     TableauPartiel = False
 
     With TableEnCours2.Rows(1).Range
          NbColonnes = .Cells.Count
          ColonneTitre = 0
          For J = 1 To NbColonnes
              If .Cells(J).Range.Shading.BackgroundPatternColorIndex = CouleurIndexTitre Then ColonneTitre = ColonneTitre + 1
          Next J
     End With
 
     If ColonneTitre < NbColonnes Then TableauPartiel = True
 
End Function
 
Sub MiseEnFormeDesBordures(ByVal SelectionTableau As Selection)
 
Dim BorduresExterieures As Variant, BorduresInterieures As Variant
Dim K As Integer
 
    BorduresExterieures = Array(-2, -4, -1, -3)
    BorduresInterieures = Array(-5)  ' Bordure horizontale
    With SelectionTableau
        For K = LBound(BorduresExterieures) To UBound(BorduresExterieures)
            With .Borders(BorduresExterieures(K))
                 .LineStyle = wdLineStyleSingle
                 .LineWidth = wdLineWidth100pt
                 .Color = RGB(146, 208, 80)
            End With
        Next K
        For K = LBound(BorduresInterieures) To UBound(BorduresInterieures)
            With .Borders(BorduresInterieures(K))
                 .LineStyle = wdLineStyleSingle
                 .LineWidth = wdLineWidth100pt
                 .Color = RGB(255, 192, 0)
            End With
        Next K
    End With
 
End Sub
 
 
Sub MefBorduresInterieuresVerticales(ByVal SelectionTableau As Selection)
 
Dim J As Integer
 
    With SelectionTableau
 
        For J = 1 To .Columns.Count - 1
            With .Columns(J).Cells
                 With .Borders(wdBorderRight)
                      If .LineStyle <> wdLineStyleNone Then
                         .LineStyle = wdLineStyleSingle
                         .LineWidth = wdLineWidth100pt
                         .Color = RGB(255, 192, 0)
                      End If
                 End With
            End With
        Next J
    End With
 
End Sub

[tom0ne]

La fonction aurait donné cela :

Bonjour Pierre,
Merci pour ton travail,

Je viens d'essayer sur le document définitif,

Autant sur le modèle de 3 tableaux le code fonctionne parfaitement, autant sur le document définitif, j'ai quelques erreurs que je ne comprends pas :

erreur d'exécution 5843
l'un des argument est hors limite

Code :

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

  .LineWidth = wdLineWidth100pt

erreur d'exécution 5992
impossible d'accéder à des colonnes individuelles de cette collection car le tableau possède des cellules de largeur différentes

Code :

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

With .Columns(J).Cells

Peut être que l'idéal serait que je t'envoie en MP le document concerné afin que tu puisses voir par toi-même et que je puisse reprendre ce que je veux exactement, on y est presque mais je désespère... surement la fatigue du vendredi

[Invité]

C'est sans doute dû à la présence de cellules fusionnées.

[tom0ne]

C'est sans doute dû à la présence de cellules fusionnées.

Bonsoir Eric,

Peut être que si tu acceptais de continuer à m'aider,
L'idéal serait peut-être de t'envoyer le document définitif pour que l'on parle de la même chose,

Je vais essayer de te résumer un peu ce que je souhaite :
Le document (et j'en ai plusieurs dixaines similaires) est composé de beaucoup de tableaux dont la première ligne de chaque tableau a un fond gris et un titre noir.
Les bordures de chaque tableau sont noires.

Mon besoin est d'alléger ces tableaux :
- Remplacer le fond gris de la première ligne par un fond blanc
- Remplacer le titre noir (première ligne du tableau) en bleu foncé
- Modifier la couleur des bordures noires du tableau en bleu foncé.
(Et ne pas remplacer la couleur des bordures si elles sont invisibles)

Je suis désolé si j'ai été confus au départ mais mes idées s'éclaircissent en travaillant sur le sujet.

Je comprendrais que je t'en demande peut être beaucoup mais tu es le seul à m'aider ici 😋

Bon dimanche

Thomas

[m@rina]

Bonsoir

B
Je comprendrais que je t'en demande peut être beaucoup mais tu es le seul à m'aider ici 😋

Désolée, mais j'ai été absente quelque temps, et j'ai vu (rapidement) qu'Eric avait pris le relais, du coup je n'ai plus suivi l'affaire...
Il faudrait effectivement voir le document tel qu'il se présente dans sa totalité, voir si tous les tableaux sont faits de la même façon, etc.
Parce que si, comme tu le dis, tous les tableaux sont vraiment faits de la même manière, on doit pouvoir s'en sortir facilement. C'est quand même la condition...

m@rina