Discussion :

[philguio]

Bonjour
Serait il possible de me donner des indication sur cette macro. En effet le résultat escompté ne ce produit pas.Bug. Je n'arrive pas a trouver d'ou vient ce problème.

Merci pour un petit coup de pouce.

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

En rouge c'est la que bug.

Précision 2 feuilles France et Departements

Merci par avance
Philippe

[Invité]

Bonjour,

Si je comprends bien, en cliquant sur le département 35 par exemple, vous mettez à jour au final un objet shape appelé "Departements035" n'est ce pas ?
Pour vérifier, sélectionnez l'objet, son nom apparaît dans la "zone nom" du menu Excel. Ne manque-t-il pas d'espace entre Departements et 035 ?

Votre ligne de code fonctionne chez moi.

Sinon,

Code :

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

 ActiveSheet.Shapes("Departements0" & numDep).Select

Cordialement.

[philguio]

Bonsoir et merci

après avoir lu votre mail j'ai modifié ceci

Code :

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

ActiveSheet.Shapes("Departement " & Format(numDep, "00")).Select

ça marche
Merci
Philippe