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
| Option Explicit
Public Const COL_CLASSE_client = 4, COL_CLASSE_CA = 6
Sub Departement_QuandClic()
'macro appelée lors d'un clic sur un département
[clNumDepartement] = Right(Application.Caller, 2)
'recupere le nom de la forme cliquée et extrait ses deux
'derniers caratères correspondant au numero du département
End Sub
Sub ColorierCarte(PlageClasses As Range, PlageLegendes As Range)
'colorie chaque departement de la carte de France en fonction du critere specifie
'ENTREE PlageClasses : indique les valeurs des classes de chaque departement (95 cellules)
' PlageLegende : indique la legende (pour la couleur de fond de chaque cellule)
' (contient autant de cellules que de valeurs de classe)
Dim numDep As Integer, numClasse As Integer, couleurClasse As Long
Dim selectionInitiale As Range
'1.memorise la position de la cellule initialement sélectionnée
Set selectionInitiale = ActiveCell
'2.colorie chaque département
For numDep = 1 To PlageClasses.Rows.Count
numClasse = PlageClasses.Cells(numDep, 1)
couleurClasse = PlageLegendes.Cells(numClasse).Interior.Color
ActiveSheet.Shapes("Departements" & Format(numDep, "000")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = couleurClasse
Next numDep
'3.restaure la position de la cellule ou plage initialement sélectionnée
selectionInitiale.Select
'4.recopie les couleurs des classes de légende
CopierCouleurFond PlageLegendes, [LegendeCarte]
End Sub
Sub ZoneChoixCarte_QuandChangement()
'procédure exécutée à chaque sélection dans la liste "Nb client / Nb Espèces"
Dim numColonne As Integer, legende As Range
'ActiveCell.Select 'pour deselectionner le ScrollBar
Select Case [clChoixCarte]
Case 1: numColonne = COL_CLASSE_client: Set legende = [Legendeclient]
Case 2: numColonne = COL_CLASSE_CA: Set legende = [LegendeCA]
End Select
ColorierCarte [PlageDepartements].Columns(numColonne), legende
End Sub
Sub CopierCouleurFond(PlageSource As Range, PlageCible As Range)
'recopie les couleurs de fond des cellules de la plage-source vers la plage-cible
'(utilisé pour les couleurs de légendes)
Dim c As Integer
For c = 1 To PlageSource.Cells.Count
PlageCible.Cells(c).Interior.ColorIndex = PlageSource.Cells(c).Interior.ColorIndex
Next c
End Sub |
