Changement de couleur de cellule en fonction menu déroulant

**Claire1461** · 23/01/2020, 17h48

Bonjour à tous, Bonne année !

J'ai un tableau dans un document word avec dans une cellule (répétée à chaque ligne) un menu déroulant.
Je souhaiterai passer par VBA pour changer la couleur de fond de la cellule (et uniquement celle-ci) en fonction du contenu de mon menu déroulant de façon automatique ou en cliquant quelque part.
je galère un peu, pour l'instant soit j'arrive à changer la couleur de fond de tout le tableau soit uniquement le champ (comme un surlignage), soit la cellule dans laquelle je clique pour sortir de mon menu déroulant....

Je sèche, pouvez-vous m'aider s'il vous plait ?

Merci beaucoup

Invité · 24/01/2020, 05h18

Envoyé par Claire1461

Bonjour,

Quel est votre code ?
Nb : Une fois votre code collé, sélectionnez-le et cliquez sur la touche # dans le menu.

**Claire1461** · 24/01/2020, 08h54

Bonjour,

Merci pour votre retour, voici le code qui me change que le fond du texte (surlignage)

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
Option Explicit
 
 
Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)
 
 
    If CC.Range.Text = "Zone A" Then
        CC.Range.Shading.BackgroundPatternColor = RGB(255, 255, 153)
 
       End If
 
       If CC.Range.Text = "Zone B" Then
        CC.Range.Shading.BackgroundPatternColor = wdColorRed
 
       End If
 
      If CC.Range.Text = "Zone C" Then
        CC.Range.Shading.BackgroundPatternColor = RGB(126, 177, 230)
 
     End If
 
    If CC.Range.Text = "Zone D" Then
        CC.Range.Shading.BackgroundPatternColor = RGB(146, 208, 80)
 
    End If
 
 
End Sub

**Arnaud2019** · 24/01/2020, 14h19

Bonjour,

D'abord ce serait plus clair de remplacer tes 4 "If" distincts par un unique "If, ElseIf, ElseIf, Else".
Pour colorer une cellule de tableau, j'ai dû faire la même chose. Au lieu de "CC.Range...", j'ai sélectionné la cellule de tableau, en connaissant le numéro du tableau "T" dans le document et les indices i-j de la cellule :

Code :

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

ActiveDocument.Tables(T).Columns(i).Cells(j).Shading.BackgroundPatternColor = RGB(228, 118, 121)

Est-ce que ça te convient?

Invité · 24/01/2020, 14h40

Envoyé par Claire1461

Le code suivant est à mettre dans un module standard :

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
 
 
Sub MettreUnFondDansUneCellule()
 
Dim oCell As Cell
Dim MaColonne As Integer
Dim HeureDebut2, HeureFin2, TempsTotal2
 
    HeureDebut2 = Timer    ' Définit l'heure de début.
 
    Application.ScreenUpdating = False
    With ActiveDocument
         MaColonne = 1
         For Each oCell In .Tables(1).Columns(MaColonne).Cells
             If oCell.Range.ContentControls.Count > 0 Then
                Select Case oCell.Range.ContentControls(1).Range
                    Case "Zone A"
                         oCell.Shading.BackgroundPatternColor = RGB(255, 255, 153)
                         oCell.Range.ContentControls(1).Range.Shading.BackgroundPatternColor = RGB(255, 255, 153)
                    Case "Zone B"
                         oCell.Shading.BackgroundPatternColor = wdColorRed
                         oCell.Range.ContentControls(1).Range.Shading.BackgroundPatternColor = wdColorRed
                    Case "Zone C"
                         oCell.Shading.BackgroundPatternColor = RGB(126, 177, 230)
                         oCell.Range.ContentControls(1).Range.Shading.BackgroundPatternColor = RGB(126, 177, 230)
                    Case "Zone D"
                         oCell.Shading.BackgroundPatternColor = RGB(146, 208, 80)
                         oCell.Range.ContentControls(1).Range.Shading.BackgroundPatternColor = RGB(146, 208, 80)
                    Case Else
                         oCell.Shading.BackgroundPatternColor = wdColorAutomatic
                         oCell.Range.ContentControls(1).Range.Shading.BackgroundPatternColor = wdColorAutomatic
                End Select
             End If
 
         Next oCell
    End With
    Application.ScreenUpdating = True
 
    HeureFin2 = Timer    ' Définit l'heure de fin.
    TempsTotal2 = HeureFin2 - HeureDebut2    ' Calcule la durée totale.
    Debug.Print "Temps total du traitement MettreUnFondDansUneCellule du " _
                    & Date & " : " & Round(TempsTotal2, 0) & " seconde(s)"
 
End Sub

Le code suivant remplace celui dans ThisDocument

Code :

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

1
2
3
4
5
6
 
Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)
 
    MettreUnFondDansUneCellule
 
End Sub

Le soucis est que le temps de traitement est prohibitif : 3 secondes pour 64 cellules / colonne (processeur I7), car il ne m'a pas été possible d'associer le contrôle à sa cellule. La parade serait de lancer la procédure à partir d'un bouton dans la barre d'accès rapide à la fin d'une mise à jour par exemple.

**Claire1461** · 24/01/2020, 15h22

Envoyé par Arnaud2019

Merci pour votre réponse. J'ai remplacé mes 4 "if"

. J'ai essayé le code mais j'obtiens un message d'erreur et c'est systématique dès que je souhaite utiliser la cellule comme définition. :

erreur de compilation - variable non définie

avec Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean) surligné en jaune et (j) en bleu

Envoyé par Eric KERGRESSE

Merci Eric, je vais regarder ça ce week-end car cela a l'air complexe de mon niveau... Pour le temps de traitement pas de soucis, je n'ai qu'un tableau avec je pense au maximum une centaine de cellule. Je souhaiterai éviter le bouton.

Invité · 24/01/2020, 15h47

Envoyé par Claire1461

C'est trop long. Ci-joint, ma solution avec le bouton dans la barre d'accès rapide.

Pièce jointe 533377

**Arnaud2019** · 24/01/2020, 16h54

Avez-vous remplacé T, i et j dans la ligne de code que je vous ai passée?
Si c'est la ligne 3 de la colonne 5 du 2ème tableau du document qu'il faut colorer, ça donnera :

Code :

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

ActiveDocument.Tables(2).Columns(5).Cells(3).Shading.BackgroundPatternColor = RGB(228, 118, 121)

Est-ce que ça marche?

**Claire1461** · 24/01/2020, 17h19

Envoyé par Arnaud2019

Merci pour la précision, je n'avais pas modifié effectivement. Malheureusement ça ne fonctionne pas comme je le souhaite. En effet, je pourrai avoir jusqu'à une centaine de ligne avec le menu déroulant répété et du coup chaque cellule à colorer indépendamment et qui change si je change le contenu du menu déroulant. De plus, mon contrôle de menu déroulant se supprime après malgré l'option non retenue.

Envoyé par Eric KERGRESSE

Merci Eric, j'ai testé, ça fonctionne, mais ça ne correspond pas vraiment à ce que je souhaite faire. Je ne souhaite pas de bouton et effectivement le temps avant mise à jour est long.

Invité · 24/01/2020, 18h00

Envoyé par Claire1461

Vos ContentControls ont-ils un titre ? Peuvent-ils en recevoir ?

Invité · 24/01/2020, 19h15

Envoyé par Claire1461

Merci Eric, j'ai testé, ça fonctionne, mais ça ne correspond pas vraiment à ce que je souhaite faire. Je ne souhaite pas de bouton et effectivement le temps avant mise à jour est long.

Le principe est d'indexer les ContentControls à l'ouverture du document et de charger une matrice pour établir la correspondance entre la cellule et l'index du contrôle.

Dans ThisDocument, on trouve :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Option Explicit
 
Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)
 
        MettreUnFondDansUneCellule1 CC
 
End Sub
 
Private Sub Document_Open()
 
        ChargerLaMatriceCC
 
End Sub

La procédure ChargerLaMatriceCC dans un module standard est la suivante :

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
 
Option Explicit
 
Public MatriceCC() As Variant
 
 
 
Sub ChargerLaMatriceCC()
 
Dim I As Long, IndexEnCours As Long
 
    With ActiveDocument.Tables(1).Columns(1)
         IndexEnCours = 1
         For I = 1 To .Cells.Count '.ContentControls.Count
             ReDim Preserve MatriceCC(1, IndexEnCours - 1)
             MatriceCC(0, IndexEnCours - 1) = I
             With .Cells(I)
                  If .Range.ContentControls.Count > 0 Then
                     .Range.ContentControls(1).Title = IndexEnCours
                     MatriceCC(1, IndexEnCours - 1) = IndexEnCours
                     IndexEnCours = IndexEnCours + 1
                  End If
             End With
         Next I
    End With
 
   ' For I = LBound(MatriceCC, 2) To UBound(MatriceCC, 2)
   '   Debug.Print MatriceCC(0, I) & " : " & MatriceCC(1, I)
   ' Next I
 
End Sub

La procédure dans un module standard liée à l'événement Document_ContentControlOnExit est la suivante :

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
 
 
Sub MettreUnFondDansUneCellule1(ByVal CC2 As ContentControl)
 
Dim oCell As Cell
Dim MaColonne As Integer
'Dim HeureDebut2, HeureFin2, TempsTotal2
Dim I As Long
 
   ' HeureDebut2 = Timer    ' Définit l'heure de début.
    MaColonne = 1
 
    Application.ScreenUpdating = False
 
    With ActiveDocument
 
         For I = LBound(MatriceCC, 2) To UBound(MatriceCC, 2)
             If MatriceCC(1, I) = CC2.Title Then
                Debug.Print MatriceCC(0, I) & " : " & MatriceCC(1, I)
                Set oCell = .Tables(1).Columns(MaColonne).Cells(MatriceCC(0, I))
                With oCell
                     Select Case CC2.Range
                            Case "Zone A"
                                 .Shading.BackgroundPatternColor = RGB(255, 255, 153)
                                 CC2.Range.Shading.BackgroundPatternColor = RGB(255, 255, 153)
                            Case "Zone B"
                                 .Shading.BackgroundPatternColor = wdColorRed
                                 CC2.Range.Shading.BackgroundPatternColor = wdColorRed
                            Case "Zone C"
                                 .Shading.BackgroundPatternColor = RGB(126, 177, 230)
                                 CC2.Range.Shading.BackgroundPatternColor = RGB(126, 177, 230)
                            Case "Zone D"
                                 .Shading.BackgroundPatternColor = RGB(146, 208, 80)
                                 CC2.Range.Shading.BackgroundPatternColor = RGB(146, 208, 80)
                            Case Else
                                 .Shading.BackgroundPatternColor = wdColorAutomatic
                                 CC2.Range.Shading.BackgroundPatternColor = wdColorAutomatic
                      End Select
                End With
                Set oCell = Nothing
                Exit For
 
             End If
 
         Next I
 
 
    End With
    Application.ScreenUpdating = True
 
   ' HeureFin2 = Timer    ' Définit l'heure de fin.
   ' TempsTotal2 = HeureFin2 - HeureDebut2    ' Calcule la durée totale.
   ' Debug.Print "Temps total du traitement MettreUnFondDansUneCellule du " _
   '                 & Date & " : " & Round(TempsTotal2, 0) & " seconde(s)"
 
End Sub

Invité · 25/01/2020, 05h43

J'ai créé ce billet dans mon blog reprenant les derniers changements : Changement-couleur-fond-cellules-fonction-contentcontrols.

**Claire1461** · 26/05/2020, 17h19

Bonjour,

Désolée pour ma longue absence mais quelques soucis ne m'ont pas permis de poursuivre la discussion et les recherches. Enfin je peux m'y remettre.
Merci à tous pour votre aide et votre implication.

J'ai repris mon fichier et ce fichu tableau.
J'ai effectué quelques recherches et fait des tests.
Bon évidemment rien ne fonctionnait

J'ai trouvé plusieurs codes sur le net (faqword) (colorer le texte du menu déroulant et colorer une cellule suivant un texte).
Et enfin, après plusieurs jours de galère, j'ai réussi à mixer les deux pour faire ça. Youhouuuuuuuuuuuuuuuu !
Ça fonctionne très bien. Il me reste à trouver comment faire en sorte que ça ne se colorie pas si je n'ai aucune des valeurs Zones A/B ou C. (soit une autre zone, soit choisissez un élément soit une entrée libre de texte). Je pense avec des IF à la suite mais pour l'instant je n'y suis pas arrivée.
Je poste le code au cas où ça aiderait quelqu'un.

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
Private Sub document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If ContentControl.Title = "Zone" Then
 
    Dim cellule As CELL, ligne As Row, zone
    For Each ligne In ActiveDocument.Tables(1).Rows
        For Each cellule In ligne.Cells
 
            With cellule.Shading
                Select Case zone
                    Case zone = InStr(1, cellule.Range.Text, "Zone A")
                        .BackgroundPatternColor = wdColorBrightGreen
                    Case zone = InStr(1, cellule.Range.Text, "Zone B")
                        .BackgroundPatternColor = wdColorLightYellow
                    Case zone = InStr(1, cellule.Range.Text, "Zone C")
                        .BackgroundPatternColor = wdColorPaleBlue
                End Select
            End With
        Next
    Next ligne
End If
End Sub

Invité · 27/05/2020, 05h51

Envoyé par Claire1461

Bonjour,

Il te faut ajouter un Case Else à la suite et prendre la couleur blanche j'imagine. Regarde les valeurs sur l'aide Microsoft : https://docs.microsoft.com/fr-fr/dot...?view=word-pia

**Claire1461** · 27/05/2020, 09h43

Bponjour Eric,

Merci de ton retour super rapide.
Génial, ça fonctionne exactement comme je voulais. Merci encore.

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
Private Sub document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If ContentControl.Title = "Zone" Then
 
    Dim cellule As CELL, ligne As Row, zone
    For Each ligne In ActiveDocument.Tables(1).Rows
        For Each cellule In ligne.Cells
 
            With cellule.Shading
                Select Case zone
                    Case zone = InStr(1, cellule.Range.Text, "Zone A")
                        .BackgroundPatternColor = wdColorBrightGreen
                    Case zone = InStr(1, cellule.Range.Text, "Zone B")
                        .BackgroundPatternColor = wdColorLightYellow
                    Case zone = InStr(1, cellule.Range.Text, "Zone C")
                        .BackgroundPatternColor = wdColorPaleBlue
                    Case Else
                        .BackgroundPatternColor = wdColorAutomatic
 
                End Select
            End With
        Next
    Next ligne
End If
End Sub

Changement de couleur de cellule en fonction menu déroulant [WD-365]

VBA Word

Discussions similaires

Partager

Partager