在Excel工作簿中找不到链接-Java 学习之路

我've written a macro to open several password protected workbooks. The workbooks all have links between each other so for the sake of convenience, I'已设置 UpdateLinks:=0 ，以便在其他书籍打开之前，我不会收到所有链接更新的密码提示 .

在所有工作簿打开后，我尝试使用更新链接

Workbooks("Workbook1").UpdateLink Type:=1
Workbooks("Workbook2").UpdateLink Type:=1
Workbooks("Workbook3").UpdateLink Type:=1
Workbooks("Workbook4").UpdateLink Type:=1

这样更方便，因为工作簿现在是打开的，因此不需要密码提示 .

这在两个工作簿上工作正常，但另外两个提示我找到不存在的链接的源 . 这就是工作簿中不存在的实际链接..

我花了好几个小时试图找出它从哪里获得这个链接，但它根本不存在于任何地方..

为了更清楚，在工作簿2中我有三个链接A，B和C.这些在数据>编辑链接菜单中可见 . 但是，当我运行宏时，它要求我找到链接E的源...

我已经尝试了下面的内容，看看是否存在因某种原因无法看到的链接

Workbooks("Workbook2").Activate

aLinks = ActiveWorkbook.LinkSources(1)
If Not IsEmpty(aLinks) Then
    For i = 1 To UBound(aLinks)
        MsgBox "Link " & i & ":" & Chr(13) & aLinks(i) 
    Next i
End If

这只是向我展示了我在编辑链接中可以看到的三个 .

我在工作簿中搜索了它试图让我找到该文件的链接的名称，没有任何内容 .

有没有人见过这个或有任何想法？它让我难过，并且本来应该是一件非常令人沮丧的简单工作 .

1 回答

工作簿之间的链接可以通过多种方式创建（有意或无意）：

1. Within formulae 
2. Inside range names
3. Inside chart ranges

Excel用户通常熟悉（1），并搜索引用链接的文本，但这不会检测图表和范围名称中的链接 .

Bill Manville的findlink是寻找和/或删除这些链接的出色解决方案 .

下载插件，选择带有链接的文件，从Excel运行插件（Bill的页面上的说明）然后

在下拉框中选择您要查找的参考
我选择找到的选项，然后列出链接

各种链接类型的样本

enter image description here

样本输出

enter image description here

几年前，我在编写自己的链接查找器时遇到了麻烦，下面的代码以防它被证明有用

码

Option Explicit

' This code searches all sheets (worksheets and chart sheets) in the ActiveWorkbook for links
' and compiles a filtered CSV file to report on any:
' #1 Formula links (and validates them against linksources)
' #2 Range Name links
' #3 PivotTable links
' #4a Chart Series links (in both Chart Sheets and Charts on regular Worksheets)
' #4b Chart Title links (in both Chart Sheets and Charts on regular Worksheets)

' Download Bill Manville's FindLink at http://www.bmsltd.co.uk/MVP/Default.htm
' for a tool to manage (ie delete) links

' Notes
' 1) The Chart title method relies on activating the Chart.
'         ---> Protected sheets are skipped
'         ---> This method does not work in xl2007
' 2) I have deliberately left out error handling as I want to resolve any issues

Sub ListLinks()
    Dim objFSO As Object, objFSOfile As Object
    Dim wb As Workbook, sh
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rArea As Range
    Dim chr As ChartObject, chr1 As Chart
    Dim lSource, PivCh, chrSrs
    Dim FSOFileHeader As String, tmpStr As String, chrTitle As String, FirstAddress As String, ReportFile As String, ShProt As String
    Dim nameCnt As Long
    Dim FndRngLink As Boolean, FndChrLink As Boolean, FndNameLink As Boolean, FndPivLink As Boolean

    Application.ScreenUpdating = False
    'location of report file
    ReportFile = "c:\LinkReport.csv"
    FSOFileHeader = "Type,Object Level,Location,Linked Workbook,Full Linked File Path,Reference"

    Set objFSO = CreateObject("scripting.filesystemobject")
    On Error Resume Next
    'if report file is open then ask user to close it
    Set objFSOfile = objFSO.createtextfile(ReportFile)
    If Err.Number <> 0 Then
        MsgBox "Pls close " & vbNewLine & ReportFile & vbNewLine & "then re-run code"
        Exit Sub
    End If
    On Error GoTo 0

    'write report file headers
    With objFSOfile
        .writeline ActiveWorkbook.Path & "," & ActiveWorkbook.Name
        .writeline FSOFileHeader
    End With

    For Each sh In ActiveWorkbook.Sheets

        Select Case sh.Type
        Case xlWorksheet
            'look at formula cells in each worksheet
            Set rng1 = Nothing
            Set rng2 = Nothing
            Set rng3 = Nothing

            On Error Resume Next
            Set rng1 = sh.Cells.SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
            Application.StatusBar = "Searching formulas in sheet " & sh.Name
            If Not rng1 Is Nothing Then
                'look for *.xls
                With rng1
                    Set rng2 = .Find("*.xls", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
                    If Not rng2 Is Nothing Then
                        FirstAddress = rng2.Address
                        'validate that the *.xls is part of a linksource
                        For Each lSource In ActiveWorkbook.LinkSources
                            'look in open and closed workbooks
                            If InStr(Replace(rng2.Formula, "[", vbNullString), lSource) > 0 Or InStr(rng2.Formula, Right$(rng2.Formula, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                FndRngLink = True
                                'write to the report file
                                Set rng3 = rng2
                                Exit For
                            End If
                        Next
                        'repeat till code loops back to first formula cell containing "*.xls"
                        Do
                            Set rng2 = .FindNext(rng2)
                            If rng2.Address <> FirstAddress Then
                                For Each lSource In ActiveWorkbook.LinkSources
                                    If InStr(Replace(rng2.Formula, "[", vbNullString), lSource) > 0 Or InStr(rng2.Formula, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                        Set rng3 = Union(rng3, rng2)
                                        Exit For
                                    End If
                                Next
                            End If
                        Loop Until rng2.Address = FirstAddress
                    End If
                End With
            End If

            If Not rng3 Is Nothing Then
                For Each rArea In rng3.Areas
                    objFSOfile.writeline "Formula," & "Range" & "," & sh.Name & "!" & Replace(rArea.Address(0, 0), ",", ";") & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & rng3.Cells(1).Formula
                Next
            End If

            ' Charts
            For Each chr In sh.ChartObjects
                Application.StatusBar = "Searching charts in sheet " & sh.Name
                For Each chrSrs In chr.Chart.SeriesCollection
                    If InStr(chrSrs.Formula, ".xls") <> 0 Then
                        For Each lSource In ActiveWorkbook.LinkSources
                            'look in open and closed workbooks
                            If InStr(Replace(chrSrs.Formula, "[", vbNullString), lSource) > 0 Or InStr(chrSrs.Formula, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                FndChrLink = True
                                'write to the report file
                                objFSOfile.writeline "Chart Series," & chr.Name & "," & sh.Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & Replace(chrSrs.Formula, ",", ";")
                                Exit For
                            End If
                        Next
                    End If
                Next chrSrs

                If chr.Chart.HasTitle Then
                    If sh.ProtectContents = True Then
                        ShProt = ShProt & sh.Name & " - " & chr.Name & vbNewLine
                    Else
                        chr.Activate
                        chrTitle = CStr(ExecuteExcel4Macro("GET.FORMULA(""Title"")"))
                        If InStr(chrTitle, ".xls") <> 0 Then
                            For Each lSource In ActiveWorkbook.LinkSources
                                'look in open and closed workbooks
                                If InStr(Replace(chrTitle, "[", vbNullString), lSource) > 0 Or InStr(chrTitle, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                    FndChrLink = True
                                    'write to the report file
                                    objFSOfile.writeline "Chart Title," & chr.Name & "," & sh.Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & chrTitle
                                    Exit For
                                End If
                            Next
                        End If
                    End If
                End If

            Next chr

            'Pivot Tables
            For Each PivCh In sh.PivotTables
                If InStr(PivCh.SourceData, ".xls") > 0 Then
                    For Each lSource In ActiveWorkbook.LinkSources
                        If InStr(Replace(PivCh.SourceData, "[", vbNullString), lSource) > 0 Or InStr(PivCh.SourceData, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                            objFSOfile.writeline "Pivot Table," & PivCh.Name & "," & sh.Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & PivCh.SourceData
                            FndPivLink = True
                            Exit For
                        End If
                    Next
                End If
            Next
        Case 3
            Set chr1 = Nothing
            On Error Resume Next
            Set chr1 = sh
            On Error GoTo 0
            If Not chr1 Is Nothing Then
                Application.StatusBar = "Searching charts in sheet " & sh.Name
                For Each chrSrs In chr1.SeriesCollection
                    If InStr(chrSrs.Formula, ".xls") <> 0 Then
                        For Each lSource In ActiveWorkbook.LinkSources
                            'look in open and closed workbooks
                            If InStr(Replace(chrSrs.Formula, "[", vbNullString), lSource) > 0 Or InStr(chrSrs.Formula, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                FndChrLink = True
                                'write to the report file
                                objFSOfile.writeline "Chart Series,Chart Sheet," & sh.Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & Replace(chrSrs.Formula, ",", ";")
                                Exit For
                            End If
                        Next
                    End If
                Next

                If chr1.HasTitle Then
                    chr1.Activate
                    chrTitle = CStr(ExecuteExcel4Macro("GET.FORMULA(""Title"")"))
                    If InStr(chrTitle, ".xls") <> 0 Then
                        For Each lSource In ActiveWorkbook.LinkSources
                            'look in open and closed workbooks
                            If InStr(Replace(chrTitle, "[", vbNullString), lSource) > 0 Or InStr(chrTitle, Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                                FndChrLink = True
                                'write to the report file
                                objFSOfile.writeline "Chart Title,Chart Sheet," & sh.Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & Replace(chrTitle, ",", ";")
                                Exit For
                            End If
                        Next
                    End If
                End If
            End If
        Case Else
        End Select
        'End If
    Next sh

    'Named ranges
    If ActiveWorkbook.Names.Count = 0 Then
    Else
        Application.StatusBar = "Searching range names"
        For nameCnt = 1 To ActiveWorkbook.Names.Count
            If InStr(ActiveWorkbook.Names(nameCnt), ".xls") <> 0 Then
                For Each lSource In ActiveWorkbook.LinkSources
                    If InStr(Replace(ActiveWorkbook.Names(nameCnt), "[", vbNullString), lSource) > 0 Or InStr(ActiveWorkbook.Names(nameCnt), Right$(lSource, Len(lSource) - InStrRev(lSource, "\"))) > 0 Then
                        FndNameLink = True
                        'write to the report file
                        objFSOfile.writeline "Range Name," & "Workbook level," & ActiveWorkbook.Names(nameCnt).Name & "," & Right$(lSource, Len(lSource) - InStrRev(lSource, "\")) & "," & lSource & ",'" & ActiveWorkbook.Names(nameCnt).RefersTo
                        Exit For
                    End If
                Next
                'Name link does not exist in "known" links
                If FndNameLink = False Then
                    FndNameLink = True
                    objFSOfile.writeline "Range Name," & "Workbook level," & ActiveWorkbook.Names(nameCnt).Name & "," & ActiveWorkbook.Names(nameCnt) & ",'" & Replace(ActiveWorkbook.Names(nameCnt).RefersTo, ",", ";")
                End If
            End If
        Next nameCnt
    End If

    'Close the report file
    objFSOfile.Close
    Set objFSO = Nothing

    'If at least one cell link was found then open report file
    If (FndChrLink = FndNameLink = FndRngLink = FndPivLink) And FndRngLink = False Then
        MsgBox "No formula links found", vbCritical
    Else
        Set wb = Workbooks.Open(ReportFile)
        With wb.Sheets(1)
            .Rows("1:2").Font.Bold = True
            .Columns("A:F").AutoFit
            .[A2].AutoFilter
        End With
    End If
    With Application
        .StatusBar = vbNullString
        .DisplayAlerts = True
    End With
    If ShProt <> vbNullString Then MsgBox "The following sheets were protected " & vbNewLine & "so these Chart titles could not be searched" & vbNewLine & ShProt, vbCritical
End Sub

回复于 2024-05-05T18:06:22+08:00

在Excel工作簿中找不到链接

1 回答

相关问题