【问题标题】:Cannot Break Link in Excel - VBA无法在 Excel 中断开链接 - VBA
【发布时间】:2021-04-23 17:55:16
【问题描述】:

我正在处理文件夹中所有工作簿中的一个工作表,并将其粘贴到名为 workbook2 的新工作簿中。我面临的问题是,我使用的 VBA 代码没有执行 Data->Edit Links->Break Link 操作。 因此,workbook2 会引发警告,“此工作簿包含指向一个或多个可能不安全的外部源的链接。”每次打开 workbook2 时。

复制粘贴所有工作表后,我在保存和关闭工作簿2之前用来断开链接的代码是,

On Error Resume Next
            ExternalLinks = workbook2 .LinkSources(Type:=xlLinkTypeExcelLinks)
            If IsArray(ExternalLinks) Then
                For breaklink = LBound(ExternalLinks) To UBound(ExternalLinks)
                    wb1.breaklink Name:=ExternalLinks(breaklink), Type:=xlLinkTypeExcelLinks
                Next breaklink
            End If
On Error GoTo 0

【问题讨论】:

  • 不管有没有效果。但是您不应该使用作为函数名称的变量名称(断链接)。可能会导致您发生冲突。
  • @Simon,我之前尝试过更改变量名,遇到了同样的问题。

标签: excel vba


【解决方案1】:

尝试使用下一个改编代码。当无法删除特定链接时,它应该发送一条消息:

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 的皮肤中,并找到一种更好地澄清问题的方法。知道密码后,受保护的工作表可以在尝试破坏它们的序列中之前不受保护并在最后(当然是在代码中)再次受到保护......

【讨论】:

    猜你喜欢
    • 2012-11-30
    • 2021-07-29
    • 2013-01-03
    • 1970-01-01
    • 2012-03-30
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多