Option Explicit
Sub Main()
Call DrawArrows(Range("A1"), Range("C1"))
Call DrawArrows(Range("A2"), Range("C2"), RGB(0, 0, 255))
Call DrawArrows(Range("A3"), Range("C3"), RGB(255, 0, 0), "DOUBLE")
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)
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
With Selection.ShapeRange.Line
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadStyle = msoArrowheadOpen
.Weight = 1.75
.Transparency = 0.5
If UCase(LineType) = "DOUBLE" Then
.BeginArrowheadStyle = msoArrowheadOpen
ElseIf UCase(LineType) = "LINE" Then
.EndArrowheadStyle = msoArrowheadNone
Else
End If
If RGBcolor <> 0 Then
.ForeColor.RGB = RGBcolor
Else
.ForeColor.RGB = RGB(228, 108, 10)
End If
End With
End Sub