Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1332to1336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Shape in GroupShape mit Namen ansprechen

Shape in GroupShape mit Namen ansprechen
24.10.2013 14:35:26
Reinhard
Hallo Wissende,
nachstehend ist der gesamte Code. Er funktioniert bis auf das was ich hier anfrage zuverlässig. Viermal erzeugt er jeweils als Shape ein Quadrat namens Rene_Quadrat und ein Dreieck namens Rene_Dreieck.
Beide Shapes werden dann zu einem Shape gruppiert namens Rene_Pfeillinks, Rene_Pfeillinks, usw., halt die vier Richtungen.
Bis dahin läuft alles wunderbar.
With wks 'das aktivesheet
'
' Derfunktionierende Codeteil.
'
MsgBox "-" & .Shapes("Rene_Pfeilrechts").GroupItems(2).Name & "-"
strName = .Shapes("Rene_Pfeilrechts").GroupItems(2).Name
MsgBox strName
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems(2).Fill.ForeColor.SchemeColor
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems(strName).Fill.ForeColor.SchemeColor
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems("Rene_Dreieck").Fill.ForeColor.SchemeColor

Was ich fett markiert habe sind die Codezeilen wo Laufzeitfehler xxxxxxxx kommt mit Fehlertext: "Der angegebene Wert ist außerhalb des zulässigen Bereichs."
Zigfach überprüft, auch im VBE-Lokalfenster, .GroupItems(2) heißt eindeutig
"Rene_Dreieck". strName zeigt mir das ja auch an.
Wie überrede ich Vba damit ich anstatt .GroupItems(2), .GroupItems("Rene_Dreieck")
benutzen kann?
Achja, ich will nur die Farbe des Dreiecks ändern, nix kompliziertes.
Nachstehend halt der komplette Code, läuft problemlos in jedem Standardmodul
bis zur Fehlerstelle. Deshalb keine Beispielmappe, leeres Blatt habt ihr ja wohl :-)
Gruß ^ Danke
Reinhard

Option Explicit
Sub tt()
Dim S As Shape, wks As Worksheet, strName As String
Set wks = ActiveSheet
With wks
For Each S In .Shapes
If S.Name Like "Rene*" Then S.Delete
Next S
Call PfeilErzeugen(Range("B2"), "rauf")
Call PfeilErzeugen(Range("B3"), "runter")
Call PfeilErzeugen(Range("B4"), "links")
Call PfeilErzeugen(Range("B5"), "rechts")
Set S = .Shapes("Rene_Pfeilrechts") '.GroupItems("Rene_Dreieck")
'  For Each S In .Shapes
'    If S.Name Like "Rene*" Then MsgBox S.Name
'  Next S
MsgBox "-" & .Shapes("Rene_Pfeilrechts").GroupItems(2).Name & "-"
strName = .Shapes("Rene_Pfeilrechts").GroupItems(2).Name
MsgBox strName
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems(2).Fill.ForeColor.SchemeColor
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems(strName).Fill.ForeColor.SchemeColor
MsgBox .Shapes("Rene_Pfeilrechts").GroupItems("Rene_Dreieck").Fill.ForeColor.SchemeColor
'.Shapes("Rene_Pfeilrechts").GroupItems("Rene_Dreieck").Fill.ForeColor.SchemeColor = 3
End With
End Sub
Sub PfeilErzeugen(ByRef rngZelle As Range, ByVal strRichtung As String)
Dim N As Integer, S As Shape, wks As Worksheet
Set wks = ActiveSheet
With wks
'  For Each S In .Shapes
'    If S.Name = "Rene_Quadrat" Then S.Delete
'    If S.Name = "Rene_Dreieck" Then S.Delete
'    If S.Name = "Rene_PfeilRunter" Then S.Delete
'  Next S
With rngZelle
Set S = wks.Shapes.AddShape(msoShapeRectangle, .Left, .Top, 10, 10)
End With
With S
.Name = "Rene_Quadrat"
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 45
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 64
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
With .Shapes("Rene_Quadrat")
Set S = wks.Shapes.AddShape(msoShapeIsoscelesTriangle, .Left + 2, .Top + 3, .Width - 4, . _
Height - 6)
End With
With S
.Name = "Rene_Dreieck"
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 8
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 64
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
Set S = .Shapes.Range(Array("Rene_Quadrat", "Rene_Dreieck")).Group
S.Name = "Rene_Pfeil" & strRichtung
Select Case strRichtung
Case "rauf"
.Shapes("Rene_Pfeil" & strRichtung).Rotation = 0
Case "runter"
.Shapes("Rene_Pfeil" & strRichtung).Rotation = 180
Case "links"
.Shapes("Rene_Pfeil" & strRichtung).Rotation = 270
Case "rechts"
.Shapes("Rene_Pfeil" & strRichtung).Rotation = 90
Case Else
MsgBox "Richtung falsch"
End Select
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Du musst gruppierte Shapes IMMER mit ...
24.10.2013 15:03:02
Luc:-?
…ihrem Index ansprechen, Reinhard;
ihr Name ist nur ZusatzInfo, um zB überprüfen zu können, ob man auch das Richtige erwischt hat.
Gruß Luc :-?

AW: Du musst gruppierte Shapes IMMER mit ...
26.10.2013 11:00:49
Reinhard
Hallo Luc,
ich danke dir, jetzt weiß ich Bescheid :-)
Lieben Gruß
Reinhard

Bitte sehr! Gruß owT
30.10.2013 18:00:41
Luc:-?
:-?
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige