AW: Pfeil zwischen explicit benannten Zellen zeichnen
09.12.2023 11:21:40
hary
Moin
Hier mal mein bescheidener Ansatz.
Was meinst du mit Rueckwaerts?
Erstmal von links nach rechts die Pfeile einfuegen und dann gleich anders rum? Oder einmal von links und extra von rechts.
Erklaer mal.
Sub Pfeile_setzen()
'--Codeteile von Mustafa---
Dim ZelleA As String, ZelleB As String
Dim Ax As Long, Ay As Long, Bx As Long, By As Long, i As Long
Call Pfeile_loeschen
For i = 4 To 15
If Cells(1, i) > "" Then
ZelleA = Cells(1, i)
ZelleB = Cells(2, i)
If i Mod 2 = 0 Then
Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2
Ay = Range(ZelleA).Top + (Range(ZelleA).Height / 2) - 5
Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2
By = Range(ZelleB).Top + (Range(ZelleB).Height / 2) - 5
Else
Ax = Range(ZelleA).Left + Range(ZelleA).Width / 2
Ay = Range(ZelleA).Top + (Range(ZelleA).Height / 2) + 5
Bx = Range(ZelleB).Left + Range(ZelleB).Width / 2
By = Range(ZelleB).Top + (Range(ZelleB).Height / 2) + 5
End If
ActiveSheet.Shapes.AddLine(Ax, Ay, Bx, By).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
End If
Next
Cells(1, 1).Select
End Sub
Sub Pfeile_loeschen()
With ActiveSheet
.Shapes.SelectAll
Selection.Delete
End With
End Sub
gruss hary