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
| '*********************************************************************************************************************
' Procédure permettant de rendre une carte dynamique à partir de plusieurs critères.
'*********************************************************************************************************************
Sub AfficheCouleurMap()
'déclaration des variables
Dim i As Integer
Dim RegMax As Integer
'Affectation des variables
RegMax = WorksheetFunction.CountA(Sheets("Calcul").Range("A:A")) + 1
'Boucle permettant de récupérer les différentes régions de la table source
For i = 4 To RegMax
'on récupere les noms des départements dans une zone nommée
Range("actDept").Value = Range("Calcul!A" & i).Value
'on sélectionne chacun des départements de la carte (formes/shapes) ayant le même nom
'ActiveSheet.Shapes(Range("actDept").Value).Select
'on affecte une couleur à la forme en fonction du critère défini (prévalence glaucome, glaucome traité, non-observance, glaucome non traité)
Selection.ShapeRange.Fill.ForeColor.RGB = Range(Range("actDeptCode")).Value.Interior.Color
Next i
'on se positionne en K2 au niveau de la liste Box
Range("K2").Select
End Sub |
Partager