絶対パスの外部参照をチェックする／置換する

Function f_GetArray_FullPathLink() as Variant

  Dim aryLinkAll As Variant
  Dim aryLinkChk As Variant
  Dim sPath As String
  Dim cnt As Long, i As Long

  '外部参照パスの配列
  aryLinkAll = ActiveWorkbook.LinkSources(xlExcelLinks)
  If IsEmpty(aryLinkAll) Then Exit Function

  '相対パス化できるものを除く
  ReDim aryLinkChk(1 To UBound(aryLinkAll))
  sPath = ActiveWorkbook.Path
  For i = 1 To UBound(aryLinkAll)
    If InStr(aryLinkAll(i), sPath) = 0 Then
      cnt = cnt + 1
      aryLinkChk(cnt) = aryLinkAll(i)
    End If
  Next i

  If cnt = 0 Then Exit Function
  ReDim Preserve aryLinkChk(1 To cnt)
  f_GetArray_FullPathLink = aryLinkChk
End Function

Sub 外部参照の絶対パスを置換()

  Const pathOld As String = "[Ver1]"
  Const pathNew As String = "[Ver2]"
  Dim aryPath As Variant
  Dim pathBuf As String
  Dim i As Long

  'ブック中の絶対パスによる外部参照のリスト配列
  aryPath = f_GetArray_FullPathLink
  If IsEmpty(aryPath) Then Exit Sub

  '参照パスの置換
  For i = 1 To UBound(aryPath)
    pathBuf = Replace(aryPath(i), pathOld, pathNew)
    If aryPath(i) <> pathBuf Then
      ActiveWorkbook.ChangeLink _
        aryPath(i), pathBuf, xlExcelLinks
    End If
  Next i
End Sub

Sub 外部参照の絶対パスを検索()

  Dim aryPath As Variant
  Dim rngFml As Range
  Dim rngFnd As Range
  Dim i As Long

  'ブック中の絶対パスによる外部参照のリスト配列
  aryPath = f_GetArray_FullPathLink
  If IsEmpty(aryPath) Then Exit Sub

  'フォルダーパスを抜き出し
  For i = 1 To UBound(aryPath)
    aryPath(i) = Left(aryPath(i), InStrRev(aryPath(i), "\"))
  Next i

  '絶対パスを持つ数式を検索して赤文字に
  Set rngFml = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
  With Application.ReplaceFormat
    .Clear
    .Font.Color = RGB(255, 0, 0)
  End With
  For i = 1 To cnt
    rngFml.Cells.Replace _
      What:=aryPath(i), _
      Replacement:="", _
      LookAt:=xlPart, _
      MatchCase:=False, _
      SearchFormat:=False, _
      ReplaceFormat:=True
  Next i
End Sub