[XL-2010] Associer 2 formes à une seule ligne d'un tableau [Résolu]

[SkyCorp]

Bonjour,

Ce sujet fait suite aux divers messages que j'ai postés dans le but de créer et rendre interactive sous Excel une carte d'une région de France initiallement au format SVG (cf. 1, 2 et 3). Je me suis servi pour cela du tuto Dessiner une carte de France avec les fonctions de dessins de formes libres.

La carte créée, baptisée "CarteBasRhin", est composée de nombreuses formes libres (les villes) regroupées ensembles. Chaque forme se rapporte à une ligne d'un tableau composé de 3 colonnes : l'identifiant (le code postal à peu de choses près), le nom de la ville, et une valeur associée.

Ma carte est correctement créée et je peux colorier chacune des formes libres en fonction de cette valeur associée, à une exception près : l'une des villes, baptisée "ville N" (identifiant : "CommuneVilleN"), est représentée par 2 formes libres, "ville N_1" et "ville N_2" (identifiants : "CommuneVilleN_1" et "CommuneVilleN_2").
Comme cette ville n'est présente que sur une seule ligne, ces 2 formes se rapporte à cette unique ligne. Malheureusement, mon code actuel ne colore qu'une seule des 2 formes ("ville N_1") et je ne comprends pas pourquoi, et donc je ne vois pas trop comment corriger ça.

Une idée pour m'aider à sortir de ce déboire ?

Pour information :
* Ma carte et mes données sont sur la seule feuille de mon fichier : "CA"
* Voici la macro du module "Btn_Couleur" utilisée pour colorier la carte :

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
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
Option Explicit
 
'--------------------------------------------------------------------------------
' Colore la carte en fonction de la progression du CA
'--------------------------------------------------------------------------------
Sub ColorMap()
Dim oSheet As Excel.Worksheet ' Feuille
Dim lLine As Long ' Numéro de ligne
Dim loShape As Shape ' Forme
Dim lColor As Long ' Couleur
Dim nbCouleur As Integer ' Nombre de couleurs dans l'échelle de couleurs)
Dim couleurs() As Long ' Echelle de couleurs
Dim valMin As Long ' Valeur min
Dim valMax As Long ' Valeur max
Dim valDelta As Single ' max-min+1
Dim strLegende, val1, val2 As String ' Texte de la légende
Dim Cellules As Range ' Colonne à évaluer
Dim i As Integer
 
'Définit la taille de l'échelle de couleurs
nbCouleur = 15
ReDim couleurs(nbCouleur)
' Echelle de couleur
couleurs(1) = RGB(0, 51, 0)  ' Vert pour les valeurs max
couleurs(2) = RGB(0, 128, 0)
couleurs(3) = RGB(0, 153, 0)
couleurs(4) = RGB(102, 255, 51)
couleurs(5) = RGB(153, 255, 51)
couleurs(6) = RGB(204, 255, 102)
couleurs(7) = RGB(255, 255, 102)
couleurs(8) = RGB(255, 204, 102)
couleurs(9) = RGB(255, 153, 51)
couleurs(10) = RGB(255, 102, 0)
couleurs(11) = RGB(255, 0, 0)
couleurs(12) = RGB(204, 0, 0)
couleurs(13) = RGB(165, 0, 33)
couleurs(14) = RGB(128, 0, 0)
couleurs(15) = RGB(51, 0, 0)  ' Rouge pour les valeurs min
 
' Feuille contenant la carte
Set oSheet = ActiveSheet
 
' Plage de données
Set Cellules = oSheet.Range("C2:C531")
' Valeurs min et max et grille de valeurs de la plage de données
valMin = Application.WorksheetFunction.Min(Cellules)
valMax = Application.WorksheetFunction.Max(Cellules)
valDelta = (valMax - valMin) / nbCouleur
 
' Légende
' Désactive le remplissage de la légende
oSheet.Shapes("Légende").Fill.Visible = msoFalse
' Complète la légende
For Each loShape In oSheet.Shapes("Légende").GroupItems
    ' Couleurs de remplissage
    For i = 1 To UBound(couleurs)
        ' Si la forme loShape contient le nom Legende
        If loShape.Name = "Legende " & i Then
            ' Réactive le remplissage de la forme
            loShape.Fill.Visible = True
            ' Type de remplissage = couleur unie
            loShape.Fill.Solid
            ' Pas de transparence
            loShape.Fill.Transparency = 0#
            ' Couleur de remplissage
            loShape.Fill.ForeColor.RGB = couleurs(i)
            ' Texte de la légende
'            val1 = valMin + (i - 1) * valDelta
'            val2 = valMin + i * valDelta
            val1 = valMax - i * valDelta
            val2 = valMax - (i - 1) * valDelta
            strLegende = FormatNumber(val1, 0) & " - " & FormatNumber(val2, 0)
            loShape.TextFrame.Characters.Text = strLegende
            ' La forme a été trouvée => on sort de la boucle
            Exit For
        End If
    Next i
Next
 
' Désactive le remplissage de la carte
oSheet.Shapes("CarteBasRhin").Fill.Visible = msoFalse
' Pour chaque ligne de la feuille
For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
    ' Couleurs de remplissage
    For i = 1 To UBound(couleurs)
        Select Case oSheet.Cells(lLine, 3)
'            Case valMin + (i - 1) * valDelta To valMin + i * valDelta
            Case valMax - i * valDelta To valMax - (i - 1) * valDelta
                lColor = couleurs(i)
        End Select
    Next i
    ' Parcours les départements de la carte
    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        ' Si le nom de la forme loShape contient la valeur de la première colonne
        If loShape.Name Like oSheet.Cells(lLine, 1) & "*" Then
            ' Réactive le remplissage de la forme
            loShape.Fill.Visible = True
            ' Type de remplissage = couleur unie
            loShape.Fill.Solid
            ' Pas de transparence
            loShape.Fill.Transparency = 0#
            ' Couleur de remplissage
            loShape.Fill.ForeColor.RGB = lColor
            ' La forme a été trouvée => on sort de la boucle
            Exit For
        End If
    Next
Next
End Sub

[bbil]

Bonjour,

en lisant ton code en travers ... il me semble qu'as la première coloration tu sort de ta boucle FOR :

Code :

 Exit For

si tu dois continuer à chercher il faut supprimer cette ligne....

[SkyCorp]

C'est bien ça en effet. J'avais fait une erreur de raisonnement qui m'avais empêché de voir le problème plus tôt.

J'ai dû remanier un peu le code pour que ça fonctionne, et j'en ai profité pour l'alléger un peu, et tout fonctionne très bien à présent

Merci