[XL-2010] Zone de liste liée à une carte et une zone de texte [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 500 lignes (une ligne par ville) environ et 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 presque chacune des formes libres en fonction de cette valeur associée grâce à une macro.

Je dispose également d'une macro nommée "Carte_Click" me permettant, lorsque l'utilisateur clique sur une ville particulière, de colorer la forme libre d'une autre couleur pour mieux la repérer par la suite et d'afficher les infos relatives à cette ville dans une zone de texte "info", du style :
Vous avez cliqué sur la ville : Ville N (ID XXXX)
Le CA de cette ville est : 568753 k€

Comme il n'est pas toujours aisé de connaître la position précise d'une ville sur ma carte, je souhaiterai ajouter une zone de liste baptisée "Select_Commune" listant le nom des villes et me permettant également de repérer la ville en la colorant sur la carte et d'afficher les infos relatives à cette ville dans "info".
Pour faire bien, il faudrait que en cliquant sur la carte, la zone de liste "Select_Commune" affiche aussi le nom de la ville correspondante.

J'ai tenté plusieurs techniques que j'ai trouvées au cours de mes recherches sur le web, mais rien n'a fonctionné jusqu'à présent.

Une idée pour faire cette zone de liste ?

Pour information :
* Ma carte et mes données sont sur la seule feuille de mon fichier : "CA"
* Voici la macro Carte_Click du module "Carte_Click" utilisée lorsque je clique sur 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
Sub Carte_Click()
'
Dim oSheet As Excel.Worksheet ' Feuille
Dim shpInfo As Shape
Dim loShape As Shape ' Forme
Dim strInfo, villeNum, villeNom As String
Dim i, villeTableur As Integer
Set oSheet = ThisWorkbook.Sheets("CA")
Set shpInfo = oSheet.Shapes("info")
 
'Récupère le code de la ville
villeNum = Application.Caller
 
'Recherche la position du code de la ville dans le tableur et en récupère le nom
i = 1
Do
    i = i + 1
    If Range("A" & i).Value = Application.Caller Then
        villeTableur = i
        villeNom = Range("B" & i).Value
        i = 535
    End If
Loop Until i > 534
 
'Affiche les nom et code de la ville
shpInfo.Select
strInfo = "Vous avez cliqué sur la ville : " & Chr(12) & villeNom & " (" & villeNum & ")" & vbNewLine & "xxx"
Selection.Characters.Text = strInfo
 
' Parcourt les villes de la carte pour mettre en transparence la ville sélectionnée
For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
    If loShape.Name = Application.Caller Then
        loShape.Fill.Transparency = 0.6
    Else
 
        loShape.Fill.Transparency = 0#
    End If
Next
'Range("A" & depTableur & ":D" & depTableur).Select
End Sub

* Pour remplir la zone de liste, voici la macro du classeur (l'objet nommé par défaut "ThisWorkbook") :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
' Nettoyage puis création de la liste de communes dans la liste déroulante "Select_Commune" (ref. : http://www.lesite.net/forum/affich-1266881-liste-deroulante-excel-vba#breadScrumb)
 
'--------------------------------------------------------------------------------
' Déclenchement de la procédure à l'ouverture du classeur
'--------------------------------------------------------------------------------
Private Sub Workbook_Open()
 
'Dim oSheet As Excel.Worksheet ' Feuille
'Dim lLine As Long ' Numéro de ligne
 
' Feuille contenant la carte
'Set oSheet = ThisWorkbook.Sheets("CA")
 
'oSheet.Select_Commune.Clear
'For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
'    oSheet.Select_Commune.AddItem Row.Cells(1, 2).Value & " - " & Row.Cells(1, 1).Value
'Next
ThisWorkbook.Sheets("CA").Select_Commune.ListFillRange = "B2:B529"
 
End Sub

J'avais essayé de remplir automatiquement la zone de liste mais ça n'a pas fonctionné, donc je la remplie en rentrant directement la plage maintenant. Je l'ai également mis à tout hasard quelqu'un trouve aussi une solution à ça.

[Daniel.C]

Bonjour,

J'avais essayé de remplir automatiquement la zone de liste mais ça n'a pas fonctionné

Je n'ai pas compris ce que tu voulais dire ?

J'ai positionné la listbox sur la feuille CA, il faudra modifier le code. Pour synchroniser la listbox avec le clic, ajoute :

Code :

1
2
3
4
With Sheets("CA")
    num = Application.Match(villeNom, .[B2:B529], 0)
    .Select_Commune.ListIndex = num - 1
End With

après :

Code :

'Affiche les nom et code de la ville

Si sélection par listbox, j'ai juste récupéré le nom et le code de la commune. Tu n'as plus qu'à recopier une partie de ton code (à mettre dans le module de la feuille qui contient le listbox) :

Code :

1
2
3
4
5
6
7
Private Sub Select_Commune_Click()
    Dim villeNom As String, villeNum
    With Me.Select_Commune
        villeNom = .Value
        villNum = Application.Index([CA!A2:A529], .ListIndex + 1, 1)
    End With
End Sub

[SkyCorp]

Bonjour,

Tout d'abord, merci Daniel pour ton aide.

Envoyé par Daniel.C

Je n'ai pas compris ce que tu voulais dire ?

Pour l'instant, je récupère manuellement les données dans ma liste en spécifiant la plage voulue (B2:B529) par le code

Code :

ThisWorkbook.Sheets("CA").Select_Commune.ListFillRange = "B2:B529"

Mais à terme, je voudrai que la dernière ligne de ma plage soit déterminée automatiquement.
J'avais essayé ça :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
' Nettoyage puis création de la liste de communes dans la liste déroulante "Select_Commune" (ref. : http://www.lesite.net/forum/affich-1266881-liste-deroulante-excel-vba#breadScrumb)
 
'--------------------------------------------------------------------------------
' Déclenchement de la procédure à l'ouverture du classeur
'--------------------------------------------------------------------------------
Private Sub Workbook_Open()
 
Dim oSheet As Excel.Worksheet ' Feuille
Dim lLine As Long ' Numéro de ligne
 
' Feuille contenant la carte
Set oSheet = ThisWorkbook.Sheets("CA")
 
oSheet.Select_Commune.Clear
For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
    oSheet.Select_Commune.AddItem Row.Cells(1, 2).Value
Next
End Sub

mais ça n'a pas fonctionné. J'ai par ailleurs l'impression que la variable oSheet ne fonctionne pas si elle est placée dans une macro du classeur (l'objet nommé par défaut "ThisWorkbook") alors que ça ne semble pas poser de problème avec un module.




Mis à part ce problème, j'ai placé ton premier code qui synchronise la listbox avec le clic sur ma carte et tout marche bien.

Par contre, le second code n'a pas fonctionné. Tout ce que je peux faire est sélectionner une ville dans ma liste, mais cela n'agit ni sur ma carte, ni dans ma zone de texte.
Je l'ai placé dans la feuille CA, sans succès. J'ai également essayé un module distinct, mais je n'ai pas réussi à l'associer à ma zone de liste déroulante (je n'ai pas l'option "Affecter une macro..."). Je précise que la zone de liste est un contrôle ActiveX. J'ai également essayé via un contrôle de formulaire à la place mais il faudrait sans doute modifier le code ailleurs dans ce cas.
Au passage, cliquer sur "Visualiser le code" dans le menu contextuel de ma zone de liste ajoute automatiquement

Code :

1
2
3
Private Sub Select_Commune_Change()
 
End Sub

et non "Private Sub Select_Commune_Click()", mais même ça ne change rien.

[Daniel.C]

1. remplissage de la listbox :

Code :

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_Open()
    Dim c As Range
    Dim i As Long ' Numéro de ligne
    With ThisWorkbook.Sheets("CA")
        .Select_Commune.Clear
        For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
            .Select_Commune.AddItem .Cells(i, 2).Value
        Next
    End With
End Sub

Note qu'alors, il ne faut pas renseigner la propriété ListFillRange.

Par contre, le second code n'a pas fonctionné. Tout ce que je peux faire est sélectionner une ville dans ma liste, mais cela n'agit ni sur ma carte, ni dans ma zone de texte.

Non, la macro remplit les variables villenom et villenum que tu utilises dans ta macro. Quand tu cliques sur une forme, tu renseignes ces deux variables et tu colories la forme. Est-ce que tu peux faire le contraire, colorier la commune à partir des deux variables précitées ? Si tu n'y arrives pas, dis-le.

[SkyCorp]

Je vois ce que tu veux dire.

Mais je veux bien un coup de main. N'étant pas encore très à l'aise avec VBA, j'essaie de reprendre des parties de code de ma macro "Carte_Click" mais je suis en train de me mélanger les pinceaux.

Pour le remplissage de la listbox, ça ne fonctionne pas encore.
Excel m'affiche "Erreur d'exécution '2147467259 (80004005)': Erreur non répertoriée.". Le débogueur pointe alors sur la ligne .Select_Commune.Clear.
En lisant le site de microsoft (lien) m'indique :

Pour contourner ce problème, ôter la protection de la feuille de calcul pour activer la macro à exécuter. Vous pouvez annuler manuellement la protection de la feuille de calcul ou à l'aide de la méthode Ôter la protection de la macro.

Le problème est que j'ai tenté la manip en autorisant toutes les macros, mais rien n'y fait. Mes premières recherches sur Google n'ont rien donné de concluant.
Par ailleurs, je ne vois pas trop l'utilité du Dim c As Range

[Daniel.C]

Est-ce que la feuille "CA" est protégée, et si oui, l'est-elle avec un mot de passe ?

[SkyCorp]

Non, rien n'est protégé.

[Daniel.C]

OK, j'ai aussi cette erreur et je ne comprends pas pourquoi; le code suivant fonctionne :

Code :

1
2
3
4
5
6
7
Private Sub Workbook_Open()
    Dim Plage As String
    With ThisWorkbook.Sheets("CA")
        Plage = .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp)).Address
        .Select_Commune.ListFillRange = Plage
    End With
End Sub

Je décortique l'autre macro pour régler le second problème. Ça risque de prendre un peu de temps.

Je n'ai pas la possibilité de tester. Essaie ceci :

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
Private Sub Select_Commune_Click()
    Dim villeNom As String, villeNum As String
    Dim oSheet As Excel.Worksheet ' Feuille
    Dim shpInfo As Shape
    Dim loShape As Shape ' Forme
    Dim strInfo
    Dim i As Integer, villeTableur As Integer
    With Me.Select_Commune
        villeNom = .Value
        'Récupère le code de la ville
        villeNum = Application.Index([CA!A2:A529], .ListIndex + 1, 1)
    End With
    Set oSheet = ThisWorkbook.Sheets("CA")
    ' Parcourt les villes de la carte pour mettre en transparence la ville sélectionnée
    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        If loShape.Name = villeNom Then
            loShape.Fill.Transparency = 0.6
            Set shpInfo = loShape
        Else
            loShape.Fill.Transparency = 0#
        End If
    Next
 
    'Affiche les nom et code de la ville
    shpInfo.Select
    strInfo = "Vous avez cliqué sur la ville : " & Chr(12) & villeNom & " (" & villeNum & ")" & vbNewLine & "xxx"
    Selection.Characters.Text = strInfo
End Sub

[SkyCorp]

C'est bon, le remplissage de la listbox fonctionne bien à présent
Merci

Par contre, le second code pour la synchronisation de la carte en fonction de la listbox ne fonctionne pas. Plus exactement, lorsque je sélectionne une ville dans la listbox, la forme associée ne change pas de couleur.
Tout ce que j'arrive à faire, c'est mettre à jour la zone de texte en fonction de la listbox.
J'ai un peu corrigé le code aussi pour corriger les erreurs détectés. Le voici :

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
Private Sub Select_Commune_Click()
    Dim villeNom As String, villeNum As String
    Dim oSheet As Excel.Worksheet ' Feuille
    Dim shpInfo As Shape
    Dim loShape As Shape ' Forme
    Dim strInfo As String
    Dim i As Integer, villeTableur As Integer
    With Me.Select_Commune
        villeNom = .Value
        'Récupère le code de la ville
        villeNum = Application.Index([CA!A2:A529], .ListIndex + 1, 1)
    End With
    Set oSheet = ThisWorkbook.Sheets("CA")
    Set shpInfo = oSheet.Shapes("info")
 
    ' Parcourt les villes de la carte pour mettre en transparence la ville sélectionnée
    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        If loShape.Name = villeNom Then
            loShape.Fill.Transparency = 0.6
            Set shpInfo = loShape
        Else
            loShape.Fill.Transparency = 0#
        End If
    Next
 
    'Affiche les nom et code de la ville
    shpInfo.Select
    strInfo = "Vous avez cliqué sur la ville : " & Chr(12) & villeNom & " (" & villeNum & ")" & vbNewLine & "xxx"
    Selection.Characters.Text = strInfo
End Sub

Ca doit venir de là :

Code :

1
2
3
4
5
6
7
8
    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        If loShape.Name = villeNom Then
            loShape.Fill.Transparency = 0.6
            Set shpInfo = loShape
        Else
            loShape.Fill.Transparency = 0#
        End If
    Next

Je sais que j'ai déjà eu des problèmes à utiliser des variables du style oSheet = ThisWorkbook.Sheets("CA") en dehors de modules, donc je ne sais pas si ça peut avoir un lien. J'ai tenté de changer oSheet en ThisWorkbook.Sheets("CA") dans la formule, mais ça n'a rien changé.

J'ai fait quelques tentatives, mais ça n'a rien donné. J'avais identifié à un moment un site qui permet de télécharger un fichier Excel avec le même effet que celui que je souhaite mettre en place, dans ce cas sur une carte de France, mais je n'ai pas réussi à l'adapter à mon cas.

Bref, je suis un peu perdu.

Personne n'a d'idée pour cette synchro ?

[Daniel.C]

Je vais essayer de reconstituer un classeur.

[SkyCorp]

Si besoin, je peux aussi mettre mon fichier ici en pièce jointe dès que serai rentré chez moi.

[Daniel.C]

Je ne comprends pas; j'ai repris ma dernière macro telle quelle avec un groupe de trois formes. Elle s'exécute bien (sauf la légende qui ne s'efface pas).

Ton fichier doit être beaucoup gros pour le mettre en PJ ?

[SkyCorp]

Ca va aller
Pour info, la listbox se trouve sur la droite de la page "CA"

[Daniel.C]

Ca m'a l'air correct comme ça (en fait, j'avais cru que les formes portaient le nom des communes alors qu'elles portaient le code) :

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
Private Sub Select_Commune_Click()
    Dim villeNom As String, villeNum As String
    Dim oSheet As Excel.Worksheet ' Feuille
'Dim oSheet As Excel.Worksheet ' Feuille
'Dim lLine As Long ' Numéro de ligne
    Dim shpInfo As Shape
    Dim loShape As Shape ' Forme
    Dim strInfo As String
    Dim i As Integer, villeTableur As Integer
    With Me.Select_Commune
        villeNom = .Value
        'Récupère le code de la ville
        villeNum = Application.Index([CA!A2:A529], .ListIndex + 1, 1)
    End With
    'Feuille contenant la carte
'    Set oSheet = ActiveSheet
    Set oSheet = ThisWorkbook.Sheets("CA")
    Set shpInfo = oSheet.Shapes("info")
 
    ' Parcourt les villes de la carte pour mettre en transparence la ville sélectionnée
    For Each loShape In Sheets("CA").Shapes("CarteBasRhin").GroupItems
'    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        If loShape.Name = villeNum Then
            'Sheets("CA").Shapes("CarteBasRhin").Fill.Transparency = 0.6
            loShape.Fill.Transparency = 0.6
            Set shpInfo = loShape
        Else
            loShape.Fill.Transparency = 0#
        End If
    Next
'For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
'    If Int(Row.Cells(1, 4).Value) = Cbx_Rgn.ListIndex + 1 Then
'        Evt_Dpt_Sel (Int(Row.Cells(1, 2).Value))
'        Exit For
'        End If
'    Next Row
 
    'Affiche les nom et code de la ville
    shpInfo.Select
    strInfo = "Vous avez cliqué sur la ville : " & Chr(12) & villeNom & " (" & villeNum & ")" & vbNewLine & "xxx"
    'Selection.Characters.Text = strInfo
    shpInfo.DrawingObject.Text = strInfo
    oSheet.Shapes("Info").DrawingObject.Text = strInfo
End Sub

[SkyCorp]

Ca marche impec
J'ai juste supprimé l'avant-dernière ligne (shpInfo.DrawingObject.Text = strInfo) qui semblait un peu redondante avec la ligne suivante mais qui me mettait du texte sur ma carte.

Me reste plus qu'à finaliser mon fichier en permettant l'utilisation d'une échelle personnalisée et ça sera parfait. Mais il s'agit d'un autre sujet et je posterai mes autres questions sur un nouveau post si j'en ai.

En tout cas, merci pour tout Daniel