Option Explicit

Sub Main()

    '*** zwischen A1 und C1 (Linie und Farbe => Standard)
    Call DrawArrows(Range("A1"), Range("C1"))
    
    '*** mit Farbe (Linie => Standard)
    Call DrawArrows(Range("A2"), Range("C2"), RGB(0, 0, 255))
    
    '*** mit Doppelpfeile  <----->
    Call DrawArrows(Range("A3"), Range("C3"), RGB(255, 0, 0), "DOUBLE")
    
    '*** ohne Pfeile        ------
    Call DrawArrows(Range("A4"), Range("C4"), RGB(0, 255, 0), "LINE")

End Sub

Private Sub DrawArrows(FromRange As Range, ToRange As Range, Optional RGBcolor As Long, Optional LineType As String)
'---------------------------------------------------------------------------------------------------
'---Script: DrawArrows------------------------------------------------------------------------------
'---Created by: Ryan Wells -------------------------------------------------------------------------
'---Date: 10/2015-----------------------------------------------------------------------------------
'---Description: This macro draws arrows or lines from the middle of one cell to the middle --------
'----------------of another. Custom endpoints and shape colors are suppported ----------------------
'---------------------------------------------------------------------------------------------------

Dim dleft1 As Double, dleft2 As Double
Dim dtop1 As Double, dtop2 As Double
Dim dheight1 As Double, dheight2 As Double
Dim dwidth1 As Double, dwidth2 As Double
dleft1 = FromRange.Left
dleft2 = ToRange.Left
dtop1 = FromRange.Top
dtop2 = ToRange.Top
dheight1 = FromRange.Height
dheight2 = ToRange.Height
dwidth1 = FromRange.Width
dwidth2 = ToRange.Width
 
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, dleft1 + dwidth1 / 2, dtop1 + dheight1 / 2, dleft2 + dwidth2 / 2, dtop2 + dheight2 / 2).Select
'format line
With Selection.ShapeRange.Line
    .BeginArrowheadStyle = msoArrowheadNone
    .EndArrowheadStyle = msoArrowheadOpen
    .Weight = 1.75
    .Transparency = 0.5
    If UCase(LineType) = "DOUBLE" Then 'double arrows
        .BeginArrowheadStyle = msoArrowheadOpen
    ElseIf UCase(LineType) = "LINE" Then 'Line (no arows)
        .EndArrowheadStyle = msoArrowheadNone
    Else 'single arrow
        'defaults to an arrow with one head
    End If
    'color arrow
    If RGBcolor <> 0 Then
        .ForeColor.RGB = RGBcolor 'custom color
    Else
        .ForeColor.RGB = RGB(228, 108, 10)   'orange (DEFAULT)
    End If
End With
 
End Sub

Diese Code in ein allgemeines Modul und via F5 ablaufen lassen liefert folgendes Ergebnis: