viele Pfeile via VBA erstellen, schleife/loop

Hallo,
für ein ehrenamtliches Projekt sollen auf einer Landkarte in Excel verschiedene Bewegungen mit Pfeilen in unterschiedlichen Farben, Stärken und Positionen angegeben werden.
Ich weiß wie ich mit vba die werte aus Zellen auslese und auf deren Grundlage einen Pfeil an der angegeben Position erstellen lasse.
Mein Problem ist, dass ich auf der Grafik beliebig viele (über 100) Pfeile mit einem Macroaufruf erstellen lassen möchte. Dazu brauch ich eine schleife, die einen Zellbereich verarbeitet.
Details siehe anlage. Im Tabelle1 erstelle ich einen Pfeil. Aber wie bekomme ich das hin, wenn ich viele Pfeile erstellen lassen möchte (siehe Tabelle2)?
https://www.herber.de/bbs/user/69252.xls
Vorab besten Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub pfeil2() Dim lZeile As Long For lZeile = 2 To 20 If Not Cells(lZeile, 1) = "" Then ZelleA = Cells(lZeile, 1).Value ZelleB = Cells(lZeile, 2).Value Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2 Ay = Range(ZelleA).Top + Range(ZelleA).Height / 2 Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2 By = Range(ZelleB).Top + Range(ZelleB).Height / 2 ActiveSheet.Shapes.AddLine(Ax, Ay, Bx, By).Select Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium Selection.ShapeRange.Line.ForeColor.SchemeColor = Cells(lZeile, 4).Value Selection.ShapeRange.Line.Weight = Cells(lZeile, 3).Value End If Next End Sub

Versuch einer Beschreibung:

Sub pfeil2()
Dim lZeile As Long
For lZeile = 2 To 20                           ' Anfang der Schleife lZeile steht hier für die  _
Zeilennummer von Zeile 2 bis Zeile 20
If Not Cells(lZeile, 1) = "" Then     ' Wenn Zelle(Zeile2,Spalte1) nicht = "" dann arbeite  _
den Code ab.
ZelleA = Cells(lZeile, 1).Value       'ZelleA bekommt den Wert aus Zelle(lZeile,Spalte1)
ZelleB = Cells(lZeile, 2).Value   'ZelleB bekommt den Wert aus Zelle(lZeile,Spalte2)
Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2  ' Anfangspsoition horizontaldes  _
Pfeiles errechnen
Ay = Range(ZelleA).Top + Range(ZelleA).Height / 2 ' Anfangsposition vertikal des  _
Pfeiles errechnen
Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2 ' Endpostion horizontal des Pfeiles  _
errechnen
By = Range(ZelleB).Top + Range(ZelleB).Height / 2 ' Endposition vertikal des Pfeiles  _
errechnen
ActiveSheet.Shapes.AddLine(Ax, Ay, Bx, By).Select ' Pfeil eibfügen und selektieren
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle ' Pfeiltyp angeben
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium 'Pfeilkopflänge  _
angeben
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium 'Pfeilkopfbreite  _
angeben
Selection.ShapeRange.Line.ForeColor.SchemeColor = Cells(lZeile, 4).Value ' Farbe des  _
Pfeiles aus Zelle(lZeile,spalte4 ermitteln
Selection.ShapeRange.Line.Weight = Cells(lZeile, 3).Value ' Pfeildicke aus Zelle(lZeile, _
Spalte3) ermitteln
End If    ' Wenn Zelle(Zeile2,Spalte1) nicht = "" Dann Sprung hierher
Next ' Schleifenende
End Sub

Gruß aus der Domstadt Köln.

Sub pfeil2() Dim lZeile As Long For lZeile = 2 To 20 ' Anfang der Schleife lZeile steht hier für die _ _ Zeilennummer von Zeile 2 bis Zeile 20 If Not Cells(lZeile, 1) = "" Then ' Wenn Zelle(lZeile,Spalte1) nicht = "" dann arbeite _ _ den Code ab. ZelleA = Cells(lZeile, 1).Value 'ZelleA bekommt den Wert aus Zelle(lZeile,Spalte1) ZelleB = Cells(lZeile, 2).Value 'ZelleB bekommt den Wert aus Zelle(lZeile,Spalte2) Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2 ' Anfangspsoition horizontal des _ Pfeiles errechnen Ay = Range(ZelleA).Top + Range(ZelleA).Height / 2 ' Anfangsposition vertikal des _ Pfeiles errechnen Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2 ' Endpostion horizontal des Pfeiles _ _ errechnen By = Range(ZelleB).Top + Range(ZelleB).Height / 2 ' Endposition vertikal des Pfeiles _ errechnen ActiveSheet.Shapes.AddLine(Ax, Ay, Bx, By).Select ' Pfeil einfügen und selektieren Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle ' Pfeiltyp angeben Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium 'Pfeilkopflänge _ _ angeben Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium 'Pfeilkopfbreite _ _ angeben Selection.ShapeRange.Line.ForeColor.SchemeColor = Cells(lZeile, 4).Value ' Farbe des _ Pfeiles aus Zelle(lZeile,Spalte4) ermitteln Selection.ShapeRange.Line.Weight = Cells(lZeile, 3).Value ' Pfeildicke aus Zelle(lZeile, _ _ Spalte3) ermitteln End If ' Wenn Zelle(lZeile,Spalte1) = "" Dann Sprung hierher Next ' Schleifenende End Sub

Beliebteste Forumthreads (12 Monate)

viele Pfeile via VBA erstellen, schleife/loop

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread