尝试使用下一个改编代码。当无法删除特定链接时,它应该发送一条消息:
Sub testBreakLinks()
Dim ExternalLinks, brLink As Long, WB1 As Workbook
Set WB1 = ThisWorkbook 'use here your workbook to be processed
ExternalLinks = WB1.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(ExternalLinks) Then
For brLink = LBound(ExternalLinks) To UBound(ExternalLinks)
On Error Resume Next
WB1.BreakLink name:=ExternalLinks(brLink), Type:=xlLinkTypeExcelLinks
If err.Number <> 0 Then
MsgBox err.Description & " - " & ExternalLinks(brLink)
err.Clear: On Error GoTo 0
End If
Next brLink
End If
On Error GoTo 0
End Sub
它会起作用,除了 受保护的工作表 的情况,其中外部链接不能被破坏并且不会引发错误,也不...
已编辑:
我创建了一个过程和一个函数,能够返回包含此类链接的所有单元格的地址和一个受保护工作表的列表,无法找到/破坏外部链接:
Sub testFindLinkCellAddresses()
Dim arrLnk, ExternalLinks, lnk As Variant, wb As Workbook
Set wb = ThisWorkbook
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For Each lnk In ExternalLinks
arrLnk = ExtLinkCells(CStr(lnk), wb)
If arrLnk(0)(0) <> "" Then
Debug.Print "External links for " & lnk & " exist in cells:" & vbCrLf & Join(arrLnk(0), "|")
Debug.Print "____________________________"
Else
Debug.Print "No external links found for " & lnk & vbCrLf & _
IIf(arrLnk(1)(0) <> "", "But the next sheets are protected:" & vbCrLf & _
Join(arrLnk(1), ", ") & ", " & vbCrLf & " and links cannot be found/broken even if they exist there!", "")
Debug.Print "____________________________"
End If
Next
End Sub
Function ExtLinkCells(strLnk As String, wb As Workbook) As Variant
Dim sh As Worksheet, rngForm As Range, strName As String
Dim arr, arrPr, k As Long, p As Long, cel As Range
strName = Right(strLnk, Len(strLnk) - InStrRev(strLnk, "\"))
strName = "[" & strName & "]"
ReDim arr(1000)
ReDim arrPr(wb.Sheets.count)
For Each sh In wb.Sheets
If sh.ProtectContents Then arrPr(p) = sh.name: p = p + 1
On Error Resume Next
Set rngForm = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngForm Is Nothing Then
For Each cel In rngForm.cells
If InStr(cel.Formula, strName) > 0 Then
arr(k) = Split(cel.Address(external:=True), "]")(1): k = k + 1
End If
Next
End If
Next
If k > 0 Then ReDim Preserve arr(k - 1) Else ReDim arr(0)
If p > 0 Then ReDim Preserve arrPr(p - 1) Else ReDim arrPr(0)
ExtLinkCells = Array(arr, arrPr)
End Function
当然,可以改进代码。例如,保存受保护工作表数组的数组应在模块顶部声明为Private,如果数组不为空,则跳过它们的处理部分。如果是这样的话,最后只显示一次数组内容......但我不需要这样的代码。我只是尝试将自己置于 OP 的皮肤中,并找到一种更好地澄清问题的方法。知道密码后,受保护的工作表可以在尝试破坏它们的序列中之前不受保护并在最后(当然是在代码中)再次受到保护......