I believe it would be:
Sub DrawAllPrecedents()
   Dim rgFormulas        As Excel.Range
   Dim rgCell            As Excel.Range
   Set rgFormulas = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
   For Each rgCell In rgFormulas
    FindPrecedents rgCell
   Next rgCell
End Sub

Sub FindPrecedents(rLast As Excel.Range)
    Dim iLinkNum As Integer, iArrowNum As Integer
    Dim stMsg As String
    Dim bNewArrow As Boolean
    Application.ScreenUpdating = False
    rLast.ShowPrecedents
    Call GetFormula(rLast)
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True
    Do
    Do
        Application.Goto rLast
        On Error Resume Next
        ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
        If Err.Number > 0 Then Exit Do
        On Error GoTo 0
        If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
        bNewArrow = False
        If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
            If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
                ' local
                stMsg = stMsg & vbNewLine & Selection.Address
                s = Selection.Address
                Call Arrow(rLast, rLast.Worksheet.Range(s))
            Else
                stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address
            End If
        Else
        ' external
        stMsg = stMsg & vbNewLine & Selection.Address(external:=True)
        End If
        iLinkNum = iLinkNum + 1 ' try another link
    Loop
    If bNewArrow Then Exit Do
    iLinkNum = 1
    bNewArrow = True
    iArrowNum = iArrowNum + 1 'try another arrow
    Loop
    rLast.Parent.ClearArrows
    Application.Goto rLast
    MsgBox "Precedents are" & stMsg
Exit Sub
End Sub
 
Sub Arrow(rnStart As Range, rnEnd As Range)
    Application.ScreenUpdating = False
    With ActiveSheet.Shapes.AddLine(MOC(rnStart), MOC(rnStart, True), MOC(rnEnd), MOC(rnEnd, True)).Line
    .EndArrowheadStyle = msoArrowheadTriangle
    .EndArrowheadLength = msoArrowheadLengthMedium
    .EndArrowheadWidth = msoArrowheadWidthMedium
    .Transparency = 0#
    .Visible = msoTrue
    .ForeColor.RGB = RGB(Red:=0, Green:=0, Blue:=280)
    .BackColor.RGB = RGB(0, 0, 128)
End With
End Sub
 
 'MiddleOfCell: returns just that. Needed by the Arrow procedure
Function MOC(R As Range, Optional Y As Boolean) As Long
    If Y Then
    MOC = R.Top + R.Height / 2
    Else
    MOC = R.Left + R.Width / 2
    End If
End Function