Sub ZeichneKreis()
Dim dblLeft As Double, dblTop As Double, dblDurchmesser As Double
dblLeft = Range("A1")
dblTop = Range("A2")
dblDurchmesser = Range("A3")
Call ActiveSheet.Shapes.AddShape(msoShapeOval, dblLeft, dblTop, dblDurchmesser, dblDurchmesser)
End Sub
Viele Grüße, Tobi
http://www.vba-blog.de/
AW: Kreise zeichnen
Hanspeter
Hallo Tobi,
vielen Dank, die "Produktion" klappt perfekt - doch wie kann ich den produzierten Kreis wieder ansprechen und verändern? Wenn es mehrere Kreise sind. Bei den Eigenschaften finde ich weder Positionsangaben noch Name. Nur oben im Namensfeld steht dann zB. Ellipse 18. Wo / Wie bringe ich das in VBA unter?
Gruß Hanspeter
AW: Kreise zeichnen
Tobias
Hallo Hanspeter!
Zelle A4 = Name des Kreises. Die zweite Funktion zeigt Dir auch, wie Du wieder auf die Kreise zugreifen kannst (die einfache Lösung set obj = Shapes("Kreis 1") geht - glaube ich - nicht. Wer es besser weiß darf sich gerne melden! ).
Sub ZeichneKreis()
Dim dblLeft As Double, dblTop As Double, dblDurchmesser As Double
Dim strName As String
Dim obj As Shape
dblLeft = Range("A1")
dblTop = Range("A2")
dblDurchmesser = Range("A3")
strName = Range("A4")
Set obj = ActiveSheet.Shapes.AddShape(msoShapeOval, dblLeft, dblTop, dblDurchmesser, dblDurchmesser)
obj.Name = strName
End Sub
Sub ZugriffAufKreis()
Dim strName As String
Dim obj As Shape
strName = Range("A4")
For Each obj In ActiveSheet.Shapes
If obj.Name = strName Then Exit For
Next
'mit obj kannst Du jetzt auf die Eigenschafte Deines Kreises zugreifen
obj.Left = 0
End Sub
Viele Grüße, Tobi
http://www.vba-blog.de/
AW: Kreise zeichnen
Hanspeter
Vielen Dank Tobi,
es funkt :-)
Gruß und danke auch an Karin.
Hanspeter
Eigenschaften von Shapes ändern
Shapes
Hi Tobi,
wenn der Name des Kreis-Elementes bekannt ist, geht der Zugriff auf die Eigenschaften auch ohne Schleife
Sub kreis_eigenschaften_aendern()
ActiveSheet.Shapes(Range("A4")).Left = 0
End Sub
Heute ist nicht mein Tag...
Tobias
...genau das hatte ich vorhin ausprobiert. Ohne Erfolg. Hatte mich wohl vertippt. Grummel!
Lieben Gruß, Tobi
http://www.vba-blog.de/
Meiner auch nicht :-) Negativer Left Wert
Reinhard
Hallo Karin, Interessierte,
ich habe doch schon mit negativen "Left"-Werten gearbeitet *glaub*,jedenfalls konnte ich sich bewegende Objekte die von links nach rechts "laufen", links langsam aus dem Nichts auftauchen lassen.
Jetzt gelingt mir das aber nicht mit dem Kreis, der fängt irgnedwie immer bei left = 0 an und taucht links nicht so auf wie er rechts verschwindet :-(
Sub ZugriffAufKreis()
Dim strName As String, intN, intNN, Pause
Range("A3") = 100
strName = Range("A4")
For intN = 1 To 5
For intNN = -Range("A3") To 700 + Range("A3") Step 3
ActiveSheet.Shapes(strName).Left = intNN
For Pause = 1 To 100000
Next Pause
DoEvents
Next intNN
Next intN
End Sub
Gruß
Reinhard
AW: Negativer Left Wert
Beverly
Hi Reinhard,
m. E. funktionert das nur, wenn du bei 0 beginnst (oder eben bei einem positiven Wert):
Sub ZugriffAufKreis()
Dim intN As Integer, intNN As Integer, Pause As Long
For intN = 1 To 5
For intNN = 0 To 700 Step 3
ActiveSheet.Shapes(Range("A4")).Left = intNN
For Pause = 1 To 100000
Next Pause
DoEvents
Next intNN
Next intN
End Sub
Alles klar, negatives Left geht mit Userform
Reinhard
Hallo Karin,
du hast Recht.
Ich hatte seinerzeit wohl eine UF o.ä. genommen, damit geht das.
Private Sub CommandButton1_Click()
Dim n, Pause
For n = -300 To 600 Step 3
UserForm1.Left = n
DoEvents
For Pause = 1 To 1000000
Next Pause
Next n
End Sub
Gruß
Reinhard
AW: Kreise zeichnen
Beverly
Hi Hanspeter,
Sub kreis()
Dim obKreis As Object
Set obKreis = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1"), Range("A2"), Range("A3") _
_
, Range("A3"))
End Sub
AW: Kreise zeichnen
Beverly
Hi Hanspeter,
Sub kreis()
Dim obKreis As Object
Set obKreis = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1"), Range("A2"), Range("A3") _
_
, Range("A3"))
End Sub
|
|