per VBA shapes einer dynamischen Karte mit Farben und Mustern füllen

[laberbeat]

Hallo alle miteinander,

Ich habe folgendes Problem: Ich möchte verschiedene Sachverhalte aus Parteimitgliederstatistiken in einer von mir in Excel angefertigten Karte zu den einzelnen Kreisverbänden darstellen. Diese Karte besteht aus einzelnen Shapes.
Dabei möchte ich zwei Eigenschaften der jeweiligen Kreise einander gegenüberstellen. Das soll so realisiert werden, dass Eigenschaft1 durch eine Farbe und Eigenschaft2 durch ein schwarzes Muster, das über der Farbe liegt, dargestellt wird.
Ich muss zugeben, dass ich von VBA so gut wie keine Ahnung habe.
Den Projektteil mit dem einfärben der Shapes habe ich schon anhand einer Beschreibung im Internet hinbekommen (Anleitung zur Erstellung von Dynamischen Karten bei Youtube)

Ich habe mal eine Beispielmappe angelegt, die nur mit einem kleinen Teil der Shapes arbeitet, da Sie sonst zu groß zum uploaden gewesen wäre.
  Mitgleiderstatistiken_Kreise_Beispiel.xlsm (Größe: 406,43 KB / Downloads: 11)

Ich habe die Arbeitsmappe  dann so erweitert, dass ich analog zu den Farbetabellenblättern auch Blätter für die Muster angelegt habe und versucht den Code des Macros entsprechend anzupassen. Leider ist mir das nicht gelungen.
Excel zeigt mir dann immer Laufzeitfehler 438 an. :s


Zum Besseren Verständnis wie die Arbeitsmappe funktioniert hier mal eine etwas ausfühlichere Beschreibung, wie die Arbeitsmappe aufgebaut ist, wie sie eingentlich funktionieren soll sowie was funzt und was nicht:
 
Also im Tabellenblatt "Karte A4" befindet sich die Karte aus Shapes. Deren Namen korrelieren mit den Namen der Kreise in den "RegData"- bzw. "RegData2"-Tabellen in den Tabellenblättern "ShadingMacrosFarbe" bzw. "ShadingMacrosMuster".

Ebenfalls auf dem Tabellenblatt "Karte A4" befinden sich zwei Listenboxen mit denen man verschiedene Eigenschaften auswählen kann, die dann in der Shape-Karte dargestellt werden sollen. Die erste Listenbox ist mit dem Tabellenblatt "ShadingMacrosFarbe" und dem Marco "Shading" verbunden. Dieser Teil funktioniert schon. Die zweite Listenbox ist für die Darstellung der Muster gedacht und bezieht sich auf das Tabellenblatt "ShadingMacrosMuster" und das Macro "Shading2"

Für die Listenboxen gibt jeweils ein Tabellenblatt "Selector Items Farbe" bzw. "Selector Items Muster".
Dort sind die Inhalte der Listenboxen und die Bereichswerte für die entsprechenden Farben und Muster je nach Auswahl festgelegt. Je nachdem welche Eigenschaft man in den Listenboxen auswählt, werden unter "Metric 2" die entsprechenden Bereichswerte ausgewählt, und an die Tabellen "clsValues" bzw. "clsValues2" in den Tabellenblättern "ShadinMacrosFarbe" bzw. "ShadingMacrosMuster" weitergegeben. Das funktioniert soweit.

In den Tabellenblättern "Datentabelle Karte Farbe" bzw. "Datentabelle Karte Muster" sind die jeweiligen Datenreihen zu den in den Listenboxen stehenden Eigenschaften hinterlegt. Die in den Listenboxen getroffene Auswahl wird unter Metric angezeigt. Diese Auswahl wird dann wieder an die Tabellen RegData-Tabellen in den beiden "ShadingMacros"-Tabellenblättern weitergegeben (Sie sind in der Funktion beide identisch aufgebaut). Das funktionier auch.

In den "ShadingMacros"-Tabellenblättern gibt es dann die oben schon erwähnte Tabelle "clsValues" bzw. "clsValues2". Dort tauchen dann, wie erwähnt, die Datenbereiche wieder auf nach denen gefärbt bzw. gemustert werden soll. Links neben den Werten sind dann Felder mit der entsprechenden Farbe oder Muster. Diese bleiben statisch während die Werte dynamisch sind. Die Farb- bzw. Musterzellen sind in "class0 bis class6" bzw "class7 bis class13" umbenannt. Es sind die Farben oder Muster, mit denen die Shapes gefüllt werden sollen.

Unter der Tabelle "clsValues" befindet sich noch eine kleine Tabelle mit "ActReg" (Das ist der Name des Shapes das gefüllt werden soll. Dieser korreliert auch mit der Tabelle RegData), "ActRegValue" (hier ist eine Formel mit SVERWEIS hinterlegt, die den Wert holt, der zu füllenden Shape entspricht) und "ActRegCode" (Hier liegt eine Formel mit SVERWEIS dahinter, die dem eben ausgewählten Wert eine "class" zuweist. Das funktioniert auch schon.

Jetzt kommt der Haken, wo es bei den Farben funktioniert aber bei den Mustern nicht. Das Macro "Shading" ist für die Farben zuständig. Es durchläuft die einzelnen Shapenamen in der Tabelle "regData" Schaut dann unter "ActRegCode" nach welche Farbe bei der entsprechenden "class" hinterlegt ist und färbt das Shape dementsprechend und springt zum nächsten Shapenamen in "RegData" usw. Das funktionierz bei der Farbe auch schon soweit (es treten noch kleinere Fehler auf, die aber mit den Zahlenwerten in den Datentabellen zusammenhängen).

Das Macro "Shading2" soll das gleiche für die Muster machen. Es sollen also schwarze Muster auf die vorher mit Farben gefüllten Shapes gelegt werden. Und das funktioniert eben noch nicht. Ich vermute, dass ich im Macro "Shading2" irgendeinen Fehler gemacht habe.

Hier mal der Code des Macros "Shading2"

Sub shading2()
For i = 5 To 21
Range("actReg2").Value = Range("ShadingMacrosMuster!A" & i).Value
ActiveSheet.Shapes(Range("actReg2").Value).Select
Selection.ShapeRange.Interior.Pattern = Range(Range("actRegCode2").Value).Interior.Pattern

Next i

Range("I36").Select


End Sub


Vielleicht könnt ihr mit ja helfen.

Vielen Dank schon mal im Voraus.

Gruß Micha

[atilla]

Hallo,

kannst Du das, was Du beschreibst, manuell machen?

Wenn ja, dann zeichne den Ablauf auf, und stell den Code hier ein.

[Ego]

Hallo Micha

das Muster wird so zugewiesen:

Code:

Selection.ShapeRange.Fill.Patterned Range(Range("actRegCode2").Value).Interior.Pattern

[laberbeat]

Vielen lieben Dank Ego, dass du mir so schnell und kompetent weitergeholfen hast.

Habe deinen Code gleich eingfügt und ausprobiert ---> funktioniert wunderbar :18: , außer dass die Muster weiß sind, was etwas komisch aussieht.

Das müsste sich doch dann mit "PatternColorIndex = 1" lösen lassen, oder?

Aber die Muster sind erstmal da.

Vielen Dank nochmal

[Ego]

Hallo Micha,

du kannst ja einmal, wie Etzel vorgeschlagen hat, mit "Makro aufzeichnen" ermitteln wie die Parameterzuweisung durchgeführt werden muss.

[Ego]

Hallo Micha,

da "class7" kein Muster hat läuft das Programm auf einen Fehler hier eine mögliche Lösung:

Code:

Sub shading2()
For i = 5 To 21
Range("actReg2").Value = Range("ShadingMacrosMuster!A" & i).Value
ActiveSheet.Shapes(Range("actReg2").Value).Select
If Range("actRegCode2").Value = "class7" Then
    Selection.ShapeRange.Fill.Solid
Else
    Selection.ShapeRange.Fill.Patterned Range(Range("actRegCode2").Value).Interior.Pattern
    Selection.ShapeRange.Fill.BackColor.ObjectThemeColor = msoThemeColorText1
End If
Next i

Range("I36").Select


End Sub