Carte interactive

will1903

XLDnaute Nouveau
Bonjour,

je souhaite créer un outil excel pour mon boulot. Cet outil consiste à retrouver une liste de contactes dans une base de données à partir d'une carte de France. En effet quand je clique sur le département 62 (par exemple), je souhaite que excel me sorte la liste des contacts qui ont le département 62 dans les données.

1ère chose: Suis-je clair?
2ème: Si oui comment faut-il faire?
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonsoir will1903,

Ce que vous voulez faire est très facile en utilisant le filtre automatique.

- appliquer le filtre sur la colonne F

- cliquer sur la flèche du filtre et allez sur Filtre personnalisé

- pour le critère "est égal à" entrer *59*

Vous obtenez ainsi les lignes du département 59 (bienvenue chez les ch'ti).

Edit : autant filtrer d'ailleurs avec contient => 59

A+
 

Fichiers joints

Dernière édition:

bhbh

XLDnaute Barbatruc
Re : Carte interactive

Bonsoir,

Ton fichier, en l'état, n'est pas exploitable, pour un clic, car c'est un dessin, et les départements ne sont pas sélectionnables individuellement....

J'ai retrouvé un vieux fichier (de 2005, je crois), avec lequel on peut travailler.

J'ai laissé tous les codes initiaux (en cliquant sur un département, tu obtiens son nom, le colore, et colore la région...)

Tu peux choisir le département dans le menu déroulant, en bas à droite

Sinon, il te faudra un peu de travail, afin de rajouter les numéros de départements sur la carte....

Un premier jet : En cliquant sur le département 59 (par exemple), tu as une extraction de tes contacts à droite de l'onglet..

Bonne soirée

Edit : Hi, Job, bien le bonjour :D
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonjour bh2, heureux de te croiser :)

Bon, je n'avais même pas été voir la feuille Carte...

Effectivement avec une image faut se remuer un chouia :cool:

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonjour le fil, le forum,

Sans trop se casser la tête (mais bonjour la souris) on peut créer 96 Shapes dont le nom contient le numéro du département.

Exemple : Ellipse 01

On peut leur affecter cette macro :

Code:
Sub Filtre()
Dim dep$, plage As Range
dep = Right(Application.Caller, 2)
With Sheets("Base")
  .AutoFilterMode = False
  Set plage = .Range("F1", .[F65536].End(xlUp))
  plage.AutoFilter 1, "*" & dep & "*"
  If plage.SpecialCells(xlCellTypeVisible).Count = 1 Then
    MsgBox "Aucun contact..."
    .AutoFilterMode = False
    Exit Sub
  End If
  .Activate
End With
End Sub
Fichier (2).

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

Pour que ce soit toujours la main qui apparaisse quand on déplace la souris sur la carte, il suffit d'affecter à l'image cette macro :

Code:
Sub Rien()
End Sub
A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

Fichier (4) avec un UserForm :

Code:
Sub Filtre()
Dim dep$, plage As Range
dep = Right(Application.Caller, 2)
With Sheets("Base")
  .AutoFilterMode = False
  Set plage = .Range("F1", .[F65536].End(xlUp))
  plage.AutoFilter 1, "*" & dep & "*"
  Set plage = plage.SpecialCells(xlCellTypeVisible)
  If plage.Count = 1 Then
    MsgBox "Aucun contact..."
    .AutoFilterMode = False
    Exit Sub
  End If
End With
plage.EntireRow.Copy Sheets("Feuil3").[A1]
Set plage = Sheets("Feuil3").[A2:F2].Resize(plage.Count - 1)
ThisWorkbook.Names.Add "Contacts", plage
UserForm1.Caption = "Contacts département " & dep
UserForm1.Show
End Sub
La RowSource de la ListBox est le nom défini Contacts.

Edit : c'est mieux avec les en-têtes de colonnes...

A+
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

Avec cette histoire de main sur l'image (post #6), j'ai pédalé dans la choucroute.

En fait il est bien mieux de protéger la feuille en décochant l'option "Modifier les objets".

En plus, j'ai décoché les options de sélection des cellules.

Fichier (5).

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonjour le fil, le forum,

Une variante avec seulement 2 colonnes dans la ListBox.

Le clic sur une ligne permet de voir toutes les informations.

Le code de l'UserForm :

Code:
Private Sub ListBox1_Click()
Dim lig&
Application.Wait Now + 1 / 86400 'facultatif...
lig = ListBox1.ListIndex + 2
Unload Me
With Sheets("Filtre")
  .Rows.Hidden = False
  [Contacts].EntireRow.Hidden = True
  .Rows(lig).Hidden = False
  .Activate
End With
End Sub
Nota : j'ai un peu amélioré la macro Filtre...

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

Bien sûr on peut tout faire dans l'UserForm avec ces macros :

Code:
Private Sub Label1_Click()
ListBox1.ListIndex = -1
Me.Height = 122.25
End Sub

Private Sub ListBox1_Click()
Dim lig&
lig = ListBox1.ListIndex + 2
Me.Height = 287
With Sheets("Filtre")
  TextBox1 = .Cells(lig, 3)
  TextBox2 = .Cells(lig, 4)
  TextBox3 = .Cells(lig, 5)
  TextBox4 = .Cells(lig, 6)
End With
End Sub
On s'amuse comme on peut :)

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

On continue, en l'absence de toute réaction de l'intéressé :mad:

Si l'on veut profiter de l'affichage des informations pour les modifier dans la base.

Le mieux est alors de repérer les numéros de lignes filtrées, le repère en colonne A.

La macro du bouton "Modifier la base" :

Code:
Private Sub CommandButton1_Click() 'Modifier la base
Dim lig&
lig = ListBox1.ListIndex + 2
With Sheets("Filtre")
  .Cells(lig, 4) = TextBox1
  .Cells(lig, 5) = TextBox2
  .Cells(lig, 6) = TextBox3
  .Cells(lig, 7) = TextBox4
  lig = .Cells(lig, 1) 'Repère
End With
With Sheets("Base")
  .Cells(lig, 4) = TextBox1
  .Cells(lig, 5) = TextBox2
  .Cells(lig, 6) = TextBox3
  .Cells(lig, 7) = TextBox4
End With
MsgBox "Ligne " & lig & " modifiée dans la base..."
End Sub
Fichier (8).

A+
 

Fichiers joints

Dernière édition:

JCGL

XLDnaute Barbatruc
Re : Carte interactive

Bonjour à tous,
Salut Job :),

Je ne vois pas comment modifier ton code pour permettre un seul département par contact...

Je ne sais pas pour notre ami demandeur mais cela me convient parfaitement.

A++ l'ami
A+ à tous
 

will1903

XLDnaute Nouveau
Re : Carte interactive

Bonjour Job75

Je te remercie pour le bon boulot que tu as fait. C'est vrai que je ne me suis pas cassé la tête car je savais que cela n'était pas dans mes compétences. j'ai préféré laisser le boulot aux experts. Et puis je n'ai pas trop le temps pour me mettre à fond dans du excel. C'est pour ça que je me reconnecte seulement aujourd'hui.

Une derniere question...Est ce possible de séléctionner plusieurs départements à la fois???

Merci par avance.
 

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

@ JCGL : si l'on veut pouvoir entrer un seul département sur un contact, mettre la colonne Départements au format Texte.

@ will1903 : on ne peut cliquer que sur une shape à la fois, donc avec cette solution, pas possible de "sélectionner" plusieurs départements.

Merci à DoubleZero, JC, Victor et piga25 pour tous ces Likes, ça me fait très plaisir :)

A+
 

JCGL

XLDnaute Barbatruc
Re : Carte interactive

Bonjour à tous,

Merci Gérard pour ce complément d’information.

A++
A + à tous
 

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonjour will1903, le fil,

Une derniere question...Est ce possible de séléctionner plusieurs départements à la fois???
En fait c'est un joli complément, merci d'avoir posé cette question.

Dans le fichier joint, si l'on clique sur le bouton Mémorisation des départements, on peut cliquer ensuite sur plusieurs départements.

La macro dans le code de la feuille Carte :

Code:
Private Sub CommandButton1_Click()
With CommandButton1
  If .Caption Like "Arr*" Then
    .Caption = "Mémorisation des départements"
    .BackColor = &HFF00& 'vert
    Filtre
  Else
    .Caption = "Arrêter la mémorisation"
    .BackColor = &H8080FF 'rose
  End If
  While .Caption Like "Arr*": DoEvents: Wend
End With
End Sub
Et dans ThisWorkbook, pour empêcher l'enregistrement ou la fermeture du fichier pendant la mémorisation :

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
With Sheets("Carte")
  If .CommandButton1.Caption Like "Arr*" Then
    Cancel = True
    .Activate
    MsgBox "Cliquer sur 'Arrêter la mémorisation'"
  End If
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Sheets("Carte")
  If .CommandButton1.Caption Like "Arr*" Then
    Cancel = True
    .Activate
    MsgBox "Cliquer sur 'Arrêter la mémorisation'"
  End If
End With
End Sub
Edit : il y avait des petites imprécisions dans la macro Filtre.

A+
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

Il y avait des petites imprécisions au début de la macro Filtre, j'ai modifié le fichier (1) précédent.

A+
 

will1903

XLDnaute Nouveau
Re : Carte interactive

Bonjour job75,

Je vois que tu t'es penché sur mon cas et je t'en remercie. Il est donc possible de choisir plusieurs départements mais le résultat n'est pas celui que j'attendais.

Exemple: si je choisi 59 et 62 le filtre me sort le transporteur qui fait du 59 et du 62
Ce que je souhaite: Je choisi 59 et 62. Et le filtre me sort les transporteur qui me font du 59 ou du 62 ou les 2

Voit si tu peut faire quelque chose sinon je garderai la version à un département.

Merci par avance
 

job75

XLDnaute Barbatruc
Re : Carte interactive

Re,

A partir de ma dernière version (sélections multiples) on devrait pouvoir en effet afficher une seule fois l'UserForm avec tous les contacts.

Et même, en évitant les doublons causés par exemple par '59 62'.

J'y avais bien pensé, mais c'est très lourd, il me semble, à programmer.

Et vu l'utilité réelle, on pourrait qualifier ça d'usine à gaz...

Je préfère donc en rester là, je pense que vous comprendrez.

A+
 

job75

XLDnaute Barbatruc
Re : Carte interactive

Bonjour will1903, le fil, le forum,

J'ai quand même essayé pour voir...

Et grâce à la fonction Union ça n'a rien d'une usine à gaz.

Et c'est bien plus élégant que la version précédente !!! :(

Voyez le fichier joint avec la macro Filtre :

Code:
Sub Filtre()
Dim dep As Range, plage1 As Range, plage2 As Range, txt$
Sheets("Carte").Activate
If [N6] = "" Then Set cel = [N6]
On Error Resume Next 'si Caller n'est pas une shape
  cel = Right(Application.Caller, 2)
  If Err = 0 Then Set cel = cel.Offset(1)
On Error GoTo 0
If [N6] = "" Or ActiveSheet.CommandButton1.Caption Like "Arr*" Then Exit Sub
For Each dep In Range("N6", cel)
  If dep = "" Then Exit For
  With Sheets("Base")
    .AutoFilterMode = False
    Set plage1 = .Range("G1", .[G65536].End(xlUp))
    plage1.AutoFilter 1, "*" & dep & "*"
    Set plage1 = plage1.SpecialCells(xlCellTypeVisible)
    .AutoFilterMode = False
  End With
  If plage1.Count > 1 Then _
    Set plage2 = Union(plage1, IIf(plage2 Is Nothing, plage1, plage2))
Next
With Sheets("Filtre")
  .[2:65536].Delete
  txt = Trim(Join(Application.Transpose(Range("N6", cel))))
  If plage2 Is Nothing Then MsgBox "Aucun contact en " & txt & "...": GoTo 1
  plage2.EntireRow.Copy .[A1]
  Set plage2 = .[B2:C2].Resize(plage2.Count - 1)
  plage2.Name = "Contacts"
End With
With UserForm1
  .Caption = "Contacts en " & txt
  .Height = 122.25
  .Show
End With
1 Range("N6", cel).ClearContents
End Sub
A+
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas