Postcode kaart Nederland-team kleur

[Sportman1975]

Beste Forumleden,

ik heb een postcode gescheiden afbeelding van Nederland in Excel.
Een team wordt toegewezen aan een bepaalde postcode (1ste 2 cijfers van postcode) en iedere postcode (2 cijferig) moet de teamkleur krijgen.
Het wordt hierdoor eenvoudig om de range te wijzigen en de kaart zal automatisch worden aangepast. Helaas lukt het mij niet om de file up-te-loaden.....dus vraag om bestand als je een oplossing heb.

 

[BjorntobeWild]

Kun je het bestand niet ergens anders uploaden en dan de link hier neerzetten?
Werkt wat makkelijker om je probleem op te lossen.

Groet,

Bjorn

 

[Sportman1975]

Bij deze het bestand

 

[BjorntobeWild]

Zoiets als dit?

Groet,

Bjorn

 

[Sportman1975]

Noem mij een newbie maar ik krijg een Run-time error '13': Type mismatch
Bedoeling is in ieder geval dat de kaart van Nederland dus "ingekleurd" wordt door de teamkleuren.

Bedankt voor je inspanning iig.....

 

[BjorntobeWild]

Welke versie van Excel gebruik je?
In 2007 werkt het nl. goed.
Kaart wordt (deels) ingekleurd.

In kolom U moet je aangeven welk Freeform bij de desbetreffende postcode (welke in kolom S staat) hoort. In kolom V zet je de kleur van het team weer.

Groet,

Bjorn

 

[Sportman1975]

2003

Kun je hem converteren naar 2003?

 

[WHER]

Een versie op basis van het bestand van BjorntobeWild, die in Excel 2003 lijkt te werken.
Zelfde opmerkingen als hierboven: In kolom U moet je aangeven welk Freeform bij de desbetreffende postcode (welke in kolom S staat) hoort. De kleur wordt echter uit kolom T gehaald (deze kleuren niet met voorw.opmaak aanbrengen!)

 

[Sportman1975]

Heren,

de macro werkt erg goed, echter de velden worden zwart gekleurd. Hoe kan ik de kleuren instellen? Of doe ik iets fout?

Sub ColorMap()
Dim c As Range
Dim myStr As String
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long
Dim i As Integer, str As String
Dim arr
ActiveSheet.Range("U:U").ClearContents
For i = 1 To ActiveSheet.Shapes.Count

With ActiveSheet.Shapes(i)
'str = ActiveSheet.Shapes(i).Name
If .Type = msoGroup Then

.Ungroup
End If
End With
Next
For i = 1 To ActiveSheet.Shapes.Count
With ActiveSheet.Shapes(i)
If Left(.Name, 8) = "Freeform" Then
str = str & "/" & .Name
End If
End With
Next
str = Mid(str, 2)
arr = Split(str, "/")
ActiveSheet.Range("U3").Resize(UBound(arr) + 1) = Application.Transpose(arr)
For Each c In [U3:U92]
On Error Resume Next
myStr = Right("000000" & Hex(c.Offset(0, 1).Interior.Color), 6)
lRed = Application.Evaluate("=Hex2dec(""" & Right(myStr, 2) & """)")
lGreen = Application.Evaluate("=Hex2dec(""" & Mid(myStr, 3, 2) & """)")
lBlue = Application.Evaluate("=Hex2dec(""" & Left(myStr, 2) & """)")
ActiveSheet.Shapes(c).Fill.ForeColor.RGB = RGB(lRed, lGreen, lBlue)

Next

End Sub

 

[WHER]

Geen idee, bij mij doet hij dat niet. Zwart lijkt er op te wijzen dat de drie RGB-waarden (lRed, lGreen, lBlue) alle drie op 0 blijven staan.
In bijlage een versie waar de originele (veel kortere) macro van Bjorn wel werkt in Excel 2003.
Code wel liefst tussen code-tags plaatsen.

 

[Sportman1975]

Helaas geeft deze ook zwarte invulling..........

So close......and so far away....

 

[Sportman1975]

Geen idee, bij mij doet hij dat niet. Zwart lijkt er op te wijzen dat de drie RGB-waarden (lRed, lGreen, lBlue) alle drie op 0 blijven staan.
In bijlage een versie waar de originele (veel kortere) macro van Bjorn wel werkt in Excel 2003.
Code wel liefst tussen code-tags plaatsen.

Hoe kan ik de RGB waarden vinden in de code?

 

[WHER]

Wanneer je de code doorloopt (met de F8 toets) zie je in de "locals window" onderaan de RGB waarden (en andere variabelen). De "locals window" open je door in "View" op het betreffende icoon te klikken (rode pijl), zie bijlage.

 

[Sportman1975]

Is er een oplossing om het werkzaam te krijgen?

 

[WHER]

In de jpg.bijlage zie je dat bij mij de RGB waarden op 0/255/255 staan. Wat gebeurt er bij jou. De variabele "myStr" staat op "FFFF00". Wat geeft dat bij jou?

 

[sylvester-ponte]

probeer deze eens ik heb de kleur berekening aangepast

Bekijk bijlage Kopie van KleurShape(2.zip

groet sylvester

 

[Sportman1975]

Heren,

hij doet het! Maar ik zie geen macro meer........klopt dit Sylvester-ponte?

OF is hij verborgen?

 

[sylvester-ponte]

ze staan gewoon in de programmacode map van sheet1

groet sylvester

 

[Sportman1975]

Om 1 of andere reden kan ik de overige eilanden niet van kleur veranderen. Hij pakt dit niet.....

Iemand enig idee hoe dit kan?

Is het ook mogelijk dat de macro werkt puur op basis van correcties die je maak en niet per se met een knop?

 

[BjorntobeWild]

Ik zal er morgen naar kijken. Mischien dat ik het dan kan verhelpen.

Groet,

Bjorn