Carte à colorer selon données

[meliinch]

Bonjour,

Débutante en VBA, je sollicite votre aide concernant le fichier en pièce jointe.
Je dois réaliser une carte d'Europe, dont les pays renseignés dans la base de données se colorent selon les chiffres de revenus de ces pays.
J'ai pour l'instant renommé les pays sur la carte, et pour faciliter la chose j'ai indiqué un code couleur selon la plage de revenu dans laquelle se situe le revenu de chaque pays.

Je bloque maintenant pour réaliser la macro. J'ai passé ma journée à chercher des demandes similaires sur Internet mais je n'arrive jamais à adapter à ce que je souhaite faire.

Je vous remercie par avance,

 

[vgendron]

Re : Carte à colorer selon données

Hello

ah.. ces cartes Choroplèthes.. rien que le nom est drole à dire

Une piste ici
https://www.excel-downloads.com/threads/carte-excel-choroplethe.182697/

 

[meliinch]

Re : Carte à colorer selon données

Bonjour,

Merci pour votre réponse.
Malheureusement, bien qu'essayant depuis presque une heure d'adapter mon fichier en m'aidant de l'autre discussion, je n'y arrive pas.

 

[vgendron]

Re : Carte à colorer selon données

Re,

voici une proposition en PJ:

Note:
dans ton tableau, il y a des pays comme "Sénégal" qui ne sont pas sur la carte..
et certains pays de la carte n'ont pas été nommés correctement..
la macro tourne quand meme car j'ai mis un control d'erreur, mais pour avoir une coloration complète, il faut que tu cliques sur chacun des pays et renommer les formes par le nom du pays.

 

[vgendron]

Re : Carte à colorer selon données

quand je dis

et certains pays de la carte n'ont pas été nommés correctement..

par exemple.. quand je clique sur la Norvège, le nom de la forme est Freeform 194:
il faut donc renommer en Norvège

mais bon. je pense que tu dois commencer par faire le tri..
ton fichier s'appele "Carte du monde", tu parles de carte d'europe, et on voit des pays d'un peu partout dans le monde..

pour le code couleur, je regarde pour modifier la macro pour que tu aies exactement les couleurs que tu souhaites

 

[meliinch]

Re : Carte à colorer selon données

Merci beaucoup !
Mon but est ensuite de créer la meme chose pour le monde, c'est pour cela que sont également présente des données monde. Et je n'ai pas les données pour tous les pays d'Europe, c'est pour cela que certains pays ne sont pas renommés sur la carte.

Est ce que vous pourriez m'expliquer comment la macro identifie dans quel plage se situe la valeur du pays ?

 

[BOISGONTIER]

Re : Carte à colorer selon données

Bonjour,

Exemples

Carte Europe
http://boisgontierjacques.free.fr/fichiers/Images/Europe.xls

Carte France départements
http://boisgontierjacques.free.fr/fichiers/Images/CarteFranceDep.xls
http://boisgontierjacques.free.fr/fichiers/Images/CarteFranceDepClic.xls

Carte du Monde

http://boisgontierjacques.free.fr/fichiers/Images/CarteMonde.xls
http://boisgontierjacques.free.fr/fichiers/Images/CarteMondeInt.xls
http://boisgontierjacques.free.fr/fichiers/Images/CarteMondeDensite.xls




Colorier les pays en fonction du CA

Sub coloriage()
  On Error Resume Next
  For Each c In [country]
   If c <> "" Then
     ca = c.Offset(, 1)
     p = Application.Match(ca, [légende], 1)
     couleur = Range("légende").Cells(p, 1).Interior.Color
     Sheets("europe").Shapes(c).Fill.ForeColor.RGB = couleur
   End If
  Next c
End Sub

Ecrire les noms des pays

Sub Ecritcountry()
  For Each c In [country]
    If c <> "" Then ecritShape c, c
  Next c
  ecritShape "Spain", "Spain", "Haut"
  ecritShape "Austria", "___Austria", "Bas"
  ecritShape "Netherlands", "NL"
  ecritShape "Belgium", "BG"
  ecritShape "Czech Republic", "Czech R"
End Sub

Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
    On Error Resume Next
    With Sheets("europe").Shapes(nomShape).TextFrame2.TextRange
        .Characters.Text = Libellé
        .Characters.Font.Size = 6
        If IsMissing(posVert) Then
          .Parent.VerticalAnchor = msoAnchorMiddle
        Else
          If posVert = "Bas" Then
           .Parent.VerticalAnchor = msoAnchorBottom
          Else
            If posVert = "Haut" Then
              .Parent.VerticalAnchor = msoAnchorTop
            Else
              .Parent.VerticalAnchor = msoAnchorMiddle
            End If
          End If
        End If
        If IsMissing(posHoriz) Then
          .Parent.HorizontalAnchor = msoAnchorCenter
        Else
          If posHoriz = "Gauche" Then
           .Parent.HorizontalAnchor = msoAnchorNone
          Else
           .Parent.HorizontalAnchor = msoAnchorCenter
          End If
        End If
     End With
End Sub

Sub ListShapes()
  i = 2
  For Each s In Sheets("europe").Shapes
     Cells(i, "k") = s.Name
     i = i + 1
  Next s
End Sub

Sub supShapes()
  For Each s In ActiveSheet.Shapes
    If s.Name Like "*Freef*" Then s.Delete
  Next s
End Sub

Bulles au survol des pays

Sub bulles()
  For Each s In Sheets("europe").Shapes
      Sheets("europe").Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
      tmp = s.Name
      bulle = Application.VLookup(tmp, [countryca], 2, False)
      If Not IsError(bulle) Then
         s.Hyperlink.ScreenTip = tmp & " Ca:" & Format(bulle, "# ##0") & Chr(10)
      Else
         s.Hyperlink.ScreenTip = "...."
      End If
  Next s
End Sub

JB

 

[vgendron]

Re : Carte à colorer selon données

Ci jointe une mise à jour avec les bonnes couleurs

pour l'explication demandée, regarde les commentaires que j'ai ajoutés dans le code.. ca devrait répondre à ta question

Je me permets aussi de t'envoyer un autre fichier perso que j'utilise pour la carte du monde complète.. si ca peut t'éviter de tout recommencer le nommage ;-)

 

[gosselien]

Re : Carte à colorer selon données

Bonjour,

comique ça, j'ai demandé le même genre de chose la semaine passée mais pour une région de Belgique

Je peux t'envoyer un exemple de ce que je travaille en ce moment , non terminé...

P.

 

[meliinch]

Re : Carte à colorer selon données

Bonjour,

Merci beaucoup pour toutes vos réponses, et pour votre rapidité !