| 12
 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 |