Wereldkaart inkleuren met behulp van celwaarden

[Fresh25]

Hallo,

Ik heb de volgende vraag. Ik heb in Excel een (deel van een) wereldkaart gemaakt met daaronder de namen van de landen en ruimte om een waarde voor een land in te vullen (zie bijlage). Nou moet de kleur van het land op de landkaart veranderen als de cel van dat land een bepaalde waarde krijgt. Bijvoorbeeld tussen 10 en 15 of 16 en 20.

Nou lukt me dit wel met 1 land (Iceland in het voorbeeld) met onderstaande code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Range("e49").Value < 10 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("e49").Value >= 10 And Range("e49").Value < 16 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 11: Exit Sub
    If Range("e49").Value >= 16 And Range("e49").Value < 21 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 12: Exit Sub
    If Range("e49").Value >= 21 And Range("e49").Value < 26 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 13: Exit Sub
    If Range("e49").Value > 25 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 14: Exit Sub
    Shapes("Iceland").Fill.ForeColor.SchemeColor = 52: Exit Sub
End Sub

Mijn vraag is: hoe kan ik dit eenvoudig doen voor meerdere landen? Dit lukt me nog niet. Ik ben een ontzettende leek op VBA gebied btw.

Alvast bedankt.

 

[chicky]

misschien een beetje brutaal en offtopic, maar heb je ook de hele wereld kaart?
zo ja, dan ben ik wel geinstreseerd om die ook te hebben.

ontopic,
Moet moet een "lijstje" maken waarin de celwaarde (zoals e49) wordt gekoppeld aan de bijbehorende shape "iceland".
Dan kan je met een loopje door het lijstje van cellen gaan waarin de waarde kan worden aangepast en dan meteen de kleur aanpassen.

Ik zit nu op m'n werk maar zal kijken of ik toch de tijd kan vinden een voorbeeldje te maken.

 

[snb]

Begin met patronen te ontdekken:

gebruik

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$49" Then Shapes("Iceland").Fill.ForeColor.SchemeColor = [E49] \ 5 + 9
End Sub

ipv

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Range("e49").Value < 10 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("e49").Value >= 10 And Range("e49").Value < 16 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 11: Exit Sub
    If Range("e49").Value >= 16 And Range("e49").Value < 21 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 12: Exit Sub
    If Range("e49").Value >= 21 And Range("e49").Value < 26 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 13: Exit Sub
    If Range("e49").Value > 25 Then Shapes("Iceland").Fill.ForeColor.SchemeColor = 14: Exit Sub
    Shapes("Iceland").Fill.ForeColor.SchemeColor = 52: Exit Sub
End Sub

 

[Fresh25]

Ok bedankt!

Maar wat doet het laatste gedeelte van deze code (de [E49] \ 5 + 9)? Op deze manier kan ik toch niet verwijzen naar een specifieke kleur en linken aan een getal?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$49" Then Shapes("Iceland").Fill.ForeColor.SchemeColor = [E49] \ 5 + 9
End Sub

@Chicky
Ik heb alleen dit gedeelte van de wereldkaart helaas

 

[snb]

O. Wat bleek uit je test van de code ?

 

[Fresh25]

O. Wat bleek uit je test van de code ?

Op zich werkt het voor het overgrote deel wel, maar niet altijd. Als ik bijvoorbeeld het getal 1,2,3 of 4 invul blijft het land wit. Als ik een getal boven de 30 invul dan verschijnen er kleuren die ik niet wil hebben.

Is het niet mogelijk ergens in de vba code te beschrijven dat bij een waarde < 10 de kleur rood moet zijn, bij een waarde tussen 10 en 15 de kleur blauw moet zijn, etc...? Meer zoals ik eerst had?

 

[jeroen562]

Fresh,

Met deze code kan je precies doen wat jij wilt en blijf het voor jezelf ook overzichtelijk wat er gebeurd in de code. Je kan hierin ook de waarde aanpassen en de kleuren aanpassen. Voor ieder land maak je eenzelfde regel aan onder de laatste en pas je alleen de shapenaam aan en de targetcell

Private Sub Worksheet_Change(ByVal Target As Range)
   Shapes("Iceland").Fill.ForeColor.SchemeColor = iif([E49]<10,10,iif([E49]<16,11,iif([E49]<21,12,iif([E49]<26,14,52))))
   Shapes("Netherlands").Fill.ForeColor.SchemeColor = iif([E50]<10,10,iif([E50]<16,11,iif([E50]<21,12,iif([E50]<26,14,52))))
End Sub

Volgens mij ben je hiermee geholpen.

Groeten

 

[Fresh25]

Jeroen, dat is precies wat ik zocht! Heel erg bedankt...
Iedereen bedankt trouwens...
:thumb:

 

[jeroen562]

Zet hem nog even op opgelost. En misschien leuk als je de wereldkaart werken nog op dit forum zet zodat anderen er ook wat mee kunnen doen misschien.

 

[Fresh25]

Prima. Ik plaats hem hier zodra die klaar is.

 

[jpunja]

Ik mag natuurlijk niet meer reageren op zo'n oud topic, maar op zich ben ik zeer benieuwd of Fresh25 de wereldkaart nog voltooid en werkend heeft gekregen. Voor een eigen project ben ik namelijk geïnteresseerd in deze tool.

 

[carina78]

Wereldkaart in Excel?

Kan iemand mij helpen aan een wereldkaart in Excel waarop ik voorraadlocaties kan laten zien met bijbehorende voorraadhoogtes? Bijv. met grotere/kleinere dots voor hoge/lage voorraden en met de mogelijkheid om de aantallen erbij te zetten.

 

[Cashem]

Kijk eens naar microsoft mappoint, gebruik ik om alles met wereld kaarten etc te doen. Werkt heerlijk.