Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Kreise zeichnen | Herbers Excel-Forum


Betrifft: Kreise zeichnen von: Hanspeter
Geschrieben am: 13.10.2008 12:49:03

Hallo zusammen,

wie kann ich per Makro einen Kreis zeichnen lassen, von welchem ich Größe und Position bestimmen und später verändern kann.

Beispiel:
Ich möchte einen Kreis auf der Position 150,200 mit einen Durchmesser von 30mm
Zelle A1 = 150
ZelleA2=200
Zelle A3= 30
Ist so etwas möglich?

Viele Grüße

Hanspeter

XP prof SP2
Office 2003

  

Betrifft: AW: Kreise zeichnen von: Tobias
Geschrieben am: 13.10.2008 12:54:02

Hallo Hanspeter!
Makro aufzeichnen und Kreis erstellen. Anschließend den Quellcode anpassen. Ob der Kreis auf DEINEM Monitor dann wirklich 30 mm Durchmesser hat ist ein anderes Thema.

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

Code eingefügt mit Syntaxhighlighter 4.15


Viele Grüße, Tobi
http://www.vba-blog.de/


  

Betrifft: AW: Kreise zeichnen von: Hanspeter
Geschrieben am: 13.10.2008 13:16:05

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


  

Betrifft: AW: Kreise zeichnen von: Tobias
Geschrieben am: 13.10.2008 13:23:50

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

Code eingefügt mit Syntaxhighlighter 4.15


Viele Grüße, Tobi
http://www.vba-blog.de/


  

Betrifft: AW: Kreise zeichnen von: Hanspeter
Geschrieben am: 13.10.2008 13:44:13

Vielen Dank Tobi,

es funkt :-)

Gruß und danke auch an Karin.

Hanspeter


  

Betrifft: Eigenschaften von Shapes ändern von: Beverly
Geschrieben am: 13.10.2008 13:45:42

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



GrußformelBeverly's Excel - Inn


  

Betrifft: Heute ist nicht mein Tag... von: Tobias
Geschrieben am: 13.10.2008 13:52:50

...genau das hatte ich vorhin ausprobiert. Ohne Erfolg. Hatte mich wohl vertippt. Grummel!

Lieben Gruß, Tobi
http://www.vba-blog.de/


  

Betrifft: Meiner auch nicht :-) Negativer Left Wert von: Reinhard
Geschrieben am: 13.10.2008 14:08:59

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


  

Betrifft: AW: Negativer Left Wert von: Beverly
Geschrieben am: 13.10.2008 15:21:02

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



GrußformelBeverly's Excel - Inn


  

Betrifft: Alles klar, negatives Left geht mit Userform von: Reinhard
Geschrieben am: 13.10.2008 15:38:15

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


  

Betrifft: AW: Kreise zeichnen von: Beverly
Geschrieben am: 13.10.2008 13:07:01

Hi Hanspeter,


Sub kreis()
   Dim obKreis As Object
   Set obKreis = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1"), Range("A2"), Range("A3") _
 _
, Range("A3"))
End Sub




GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Kreise zeichnen von: Beverly
Geschrieben am: 13.10.2008 13:08:10

Hi Hanspeter,


Sub kreis()
   Dim obKreis As Object
   Set obKreis = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1"), Range("A2"), Range("A3") _
 _
, Range("A3"))
End Sub




GrußformelBeverly's Excel - Inn


Beiträge aus den Excel-Beispielen zum Thema "Kreise zeichnen"