Probleme graph interactif et mise en forme

**vanhoa** · 23/01/2014, 03h14

Bonjour,

J'ai cree un graphique dynamique/interactif. Ce graphique affiche des courbes en fonction des regions choisies. Par exemple, si je mets ma souris sur la ville A, le graphique affiche les donnees de la ville A, sur la ville B, celles de la ville B etc...

J'ai voulu rendre le graphique plus joli en codant la mise en forme egalement.
Mon probleme est que dans ma mise en forme, j'insere un remplissage cellule et des bordures qui entourent la cellule ou il y a le nom de la ville.

Quand je pointe ma souris sur une autre ville, c'est cense supprimer la precedente mise en forme pour l'appliquer a la nouvelle plage de donnee.
En ce qui concerne le remplissage couleur, ca marche, mais pour les bordures, elles restent toujours malgre le fait de bien preciser de supprimer les bordures.

Note: ma cellule ou il y a le nom de la ville A/B/C/D, la cellule juste en dessous contient une formule personnalisee. C'est en passant la souris sur cette cellule (celle qui contient la formule) que mon graphique reagit en changeant les donnees.

La formule est:
=IFERROR(HYPERLINK(CCCchart(R19)),"click")
"CCCchart() est la fonction personnalisee ci-dessous et R19 ma cellule ou il y a le nom de la ville A par exemple. Ainsi, j'ai cette formule dans 3 autres cellules (pour la ville B, C et D)

Voici mon code:

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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
 
Public Function CCCchart(nllplage As Range)
 
'cette partie permet de rendre ma plage de donnee dynamique, cela marche, je ne pense pas que le probleme vienne de la
    Dim xater As Integer, xbter As Integer, xcter As Integer, var2ter As String, plagefinaleCCC As Range
 
        xater = 0
        xbter = 1
 
        Do
            If Worksheets("Asia Pacific WC Broken Details").Cells(3, xbter) = nllplage.Value And Worksheets("Asia Pacific WC Broken Details").Cells(4, xbter) = Worksheets("Sheet3").Cells(7, 4) Then
                    xater = xbter
                Else
                    xbter = xbter + 1
            End If
        Loop While xater = 0
 
    var2ter = Worksheets("Sheet3").Range("D6")
 
        For i = 0 To 11
                    Select Case var2ter
                        Case Is = Worksheets("Sheet3").Cells(i + 1, 2).Value
                            xcter = i
                    End Select
        Next i
 
    Set plagefinaleCCC = Range(Worksheets("Asia Pacific WC Broken Details").Cells(105, xater), Worksheets("Asia Pacific WC Broken Details").Cells(105, xater + xcter))
    ThisWorkbook.Names.Add Name:="plgref3", RefersTo:=plagefinaleCCC
 
 
'cette partie est censee supprimer mes bordures, mais ca ne marche pas
 
        With Range(Cells(18, 18), Cells(20, 21))
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
 
'Cette partie cree la mise en forme en fonction de la ou on pointe notre souris    
 
        Select Case nllplage
            Case Is = Cells(19, 18)
                Range(Cells(18, 18), Cells(20, 18)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 19), Cells(20, 21)).Interior.Color = RGB(255, 255, 255)
 
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
                Range(Cells(18, 19), Cells(20, 21)).Borders(xlEdgeTop).LineStyle = xlNone
 
 
            Case Is = Cells(19, 19)
                Range(Cells(18, 19), Cells(20, 19)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(20, 18)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(18, 20), Cells(20, 21)).Interior.Color = RGB(255, 255, 255)
 
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
 
            Case Is = Cells(19, 20)
                Range(Cells(18, 20), Cells(20, 20)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(20, 19)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(18, 21), Cells(20, 21)).Interior.Color = RGB(255, 255, 255)
 
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
 
            Case Is = Cells(19, 21)
                Range(Cells(18, 21), Cells(20, 21)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(20, 20)).Interior.Color = RGB(255, 255, 255)
 
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
 
        End Select
 
 
 
End Function

J'ai pense pour resoudre ce probleme colorer les bordures que je souhaite voir disparaitre ou lieu de les supprimer, mais ce serait trop long, et surtout, je ne comprend pas pourquoi ca ne marche pas, car le code pour supprimer marche si je l'applique dans une procedure a part.
J'ai egalement tente de supprimer ma mise en forme et de garder seulement la suppressione des bordures dans ma fonction personnalisee, mais ca ne marche pas non plus...

Je mets le fichier en piece jointe si besoin, comme ca c'est plus facile en visualisant ce qui ne marche pas.

Si vous voulez + d'explications, dites le moi :-)
Merci beaucoup de votre aide!

vanhoa

**vanhoa** · 23/01/2014, 05h44

j'ai trouve une parade en colorant au lieu de supprimer et en rendant le graphique encore plus joli :-)
mais je ne comprends toujours pas pourquoi le fait de supprimer les bordures ne marche pas :-(

voila mon code:

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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
 
 
Public Function CCCchart(nllplage As Range)
 
'dynamisation de la plage de donnees
    Dim xater As Integer, xbter As Integer, xcter As Integer, var2ter As String, plagefinaleCCC As Range
 
        xater = 0
        xbter = 1
 
        Do
            If Worksheets("Asia Pacific WC Broken Details").Cells(3, xbter) = nllplage.Value And Worksheets("Asia Pacific WC Broken Details").Cells(4, xbter) = Worksheets("Sheet3").Cells(7, 4) Then
                    xater = xbter
                Else
                    xbter = xbter + 1
            End If
        Loop While xater = 0
 
    var2ter = Worksheets("Sheet3").Range("D6")
 
        For i = 0 To 11
                    Select Case var2ter
                        Case Is = Worksheets("Sheet3").Cells(i + 1, 2).Value
                            xcter = i
                    End Select
        Next i
 
    Set plagefinaleCCC = Range(Worksheets("Asia Pacific WC Broken Details").Cells(105, xater), Worksheets("Asia Pacific WC Broken Details").Cells(105, xater + xcter))
    ThisWorkbook.Names.Add Name:="plgref3", RefersTo:=plagefinaleCCC
 
 
'coloration au lieu de suppression
 
        With Range(Cells(18, 18), Cells(20, 21))
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = -395791
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End With
 
'rajout des coloration pour les "onglets" du graph non actifs par rapport a l'ancien code    
 
        Select Case nllplage
 
            Case Is = Cells(19, 18)
                Range(Cells(18, 18), Cells(20, 18)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 19), Cells(18, 21)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(19, 19), Cells(19, 21)).Interior.Color = RGB(242, 242, 242)
 
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 18), Cells(20, 18)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 19), Cells(20, 21)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
 
                Range(Cells(18, 19), Cells(20, 21)).Borders(xlEdgeTop).LineStyle = xlNone
 
 
            Case Is = Cells(19, 19)
                Range(Cells(18, 19), Cells(20, 19)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(18, 18)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(18, 20), Cells(18, 21)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(19, 18), Cells(20, 18)).Interior.Color = RGB(242, 242, 242)
                Range(Cells(19, 20), Cells(20, 21)).Interior.Color = RGB(242, 242, 242)
 
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 19), Cells(20, 19)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 18), Cells(20, 18)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 20), Cells(20, 21)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
            Case Is = Cells(19, 20)
                Range(Cells(18, 20), Cells(20, 20)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(18, 19)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(18, 21), Cells(18, 21)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(19, 18), Cells(20, 19)).Interior.Color = RGB(242, 242, 242)
                Range(Cells(19, 21), Cells(20, 21)).Interior.Color = RGB(242, 242, 242)
 
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 20), Cells(20, 20)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 18), Cells(20, 19)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 21), Cells(20, 21)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
            Case Is = Cells(19, 21)
                Range(Cells(18, 21), Cells(20, 21)).Interior.Color = RGB(241, 245, 249)
                Range(Cells(18, 18), Cells(18, 20)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(19, 18), Cells(20, 20)).Interior.Color = RGB(242, 242, 242)
 
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                With Range(Cells(18, 21), Cells(20, 21)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With Range(Cells(20, 18), Cells(20, 20)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 5
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
 
        End Select
 
 
 
End Function

**mercatog** · 23/01/2014, 12h01

Avant tout, je propose une simplification du code. Les 4 fonctions ne font qu'une seule qui fait appel à une sous procédure générique qui permet de nommer les plages de données.

Code:

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
Option Explicit
 
Public Function GR(ByVal Rng As Range)
Dim k As Byte
 
'nommer les 4 plages
For k = 0 To 3
    NOMMER Rng, k
Next k
 
'Mise en forme de la colonne survolée
With Rng.Worksheet
    'on initialise toute la zone
    With .Range("R18").Resize(32, 4)
        .Interior.Color = 16777215
        .Font.Color = 9527351
    End With
 
    'on colorie les colonne survolée
    With Rng.Offset(-1, 0).Resize(32, 1)
        .Interior.Color = 15000000
        .Font.Color = 0
        .Font.Bold = True                        'ne marche pas
    End With
End With
End Function
 
'Sous procédure qui permet de nommer les 4 plages de données
'Typ: Type de graphique (de 0 à 3) pour les 4 graphiques
 
Private Sub NOMMER(ByVal Rng As Range, ByVal Typ As Byte)
Dim Annee As Integer, Lig As Integer
Dim Site As String, Mois As String
Dim Plage As Range, c As Range
Dim NumMois As Byte
 
Select Case Typ
    Case 0: Lig = 105
    Case 1: Lig = 108
    Case 2: Lig = 109
    Case 3: Lig = 110
End Select
 
With Worksheets("Sheet3")
    Annee = .Range("D7")
    Mois = .Range("D6")
    NumMois = Application.Match(Mois, .Range("B1:B12"), 0)
End With
 
Site = Rng.Value
 
With Worksheets("Asia Pacific WC Broken Details")
    For Each c In .Rows(3).Cells
        If c.Value = Site And c.Offset(1, 0) = Annee Then
            Set Plage = c.Offset(Lig - 3, 0).Resize(1, NumMois)
            Exit For
        End If
    Next c
 
    If Not Plage Is Nothing Then
        ThisWorkbook.Names.Add Name:="Plgref" & CStr(3 + Typ), RefersTo:=Plage
        Set Plage = Nothing
    End If
End With
End Sub

Dans la cellule à survoler, on écrit en R20 la formule qu'on tire vers la droite

Code :

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

=SIERREUR(LIEN_HYPERTEXTE(GR(R$19));6)

PS. Pour la mise en forme, certaines propriétés des cellules ne sont pas prises en compte telle Borders ou Font.Bold et je ne sais pas encore pourquoi

**vanhoa** · 24/01/2014, 02h17

Merci Mercatog pour t'etre penche sur le probleme!

Je vais lire attentivement ta simplification du code car c'est vrai que le mien etait beaucoup trop long!

Merci encore

++

vanhoa

Probleme graph interactif et mise en forme

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager