Question

我有自动更改其他工作簿的公式链接的代码。

在我的笔记本电脑上（Windows 10 Office 365），我收到运行时错误，并要求我调试以下行。

ThisWorkbook.ChangeLink Name:=strLink, NewName:=strLinkNew,  Type:=xlExcelLinks

它在运行Windows 7 Office 2010的计算机上运行。

整个代码：

Dim strFile As String
Dim aLinks As Variant
Dim i As Long
Dim strLink As String
Dim strLinkNew As String

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Show

    If .SelectedItems.Count > 0 Then
        strLinkNew = .SelectedItems(1)

        aLinks = ThisWorkbook.LinkSources(xlExcelLinks)
        If Not IsEmpty(aLinks) Then
            For i = 1 To UBound(aLinks)
                strLink = aLinks(i)
                If strLink Like "*\CRiSP*.xlsm" Then

                    'Change Linked File
                    Sheets("Links").Select
                    ThisWorkbook.Worksheets("Links").Unprotect "MYPASSWORD"
                    ThisWorkbook.ChangeLink Name:=strLink, NewName:=strLinkNew, Type:=xlExcelLinks
                    ThisWorkbook.Worksheets("Links").Protect "MYPASSWORD"
                End If
            Next
        End If
    End If
End With

Sheets("Main Menu").Select
Cells(1, 1).Select

Dim flToSave As Variant
Dim flName As String
Dim flFormat As Long

flFormat = ActiveWorkbook.FileFormat

flName = Range("A1") & Range("A2").Text
flToSave = Application.GetSaveAsFilename _
(ThisWorkbook.Path & "\" & flName, filefilter:="Excel Files (*.xlsm), *.xlsm", _
Title:="Save FileAs...")
If flToSave = False Then
    Exit Sub
Else
    ThisWorkbook.SaveAs Filename:=flToSave, FileFormat:=flFormat
End If

End Sub

Answer 1

此功能将更新链接，同时修复我尝试踩了一段时间的奇怪错误，如果活动工作表中未使用链接，则excel会给您错误1004

'''''''''''''''''
Private Function UpdateXlsLinkSource(oldLinkPathAndFile As String, newLinkPathAndFile As String) As Boolean
UpdateXlsLinkSource = False

Dim lSources As Variant
lSources = ThisWorkbook.LinkSources(xlExcelLinks) 'array that contains all the links with path to excel files

Dim FILE_NAME As String
    FILE_NAME = Right(newLinkPathAndFile, Len(newLinkPathAndFile) - InStrRev(newLinkPathAndFile, "\"))  'name of the file without path

Dim theFileIsAlreadyOpen As Boolean
    theFileIsAlreadyOpen = file_open_module.IsWorkBookOpen(FILE_NAME)   'will check if the file is is open and return true or false

'check if a file with the same name is already open
If theFileIsAlreadyOpen Then
    newLinkPathAndFile = Workbooks(FILE_NAME).PATH & "\" & Workbooks(FILE_NAME).Name    'use the open file
Else
    Workbooks.Open FileName:=newLinkPathAndFile    'open the file if it wasn't already open
End If
theFileIsAlreadyOpen = True

'CHECK IF THE FILE NEEDS UPDATING
If newLinkPathAndFile = oldLinkPathAndFile Then
    UpdateXlsLinkSource = True  'if the link is unchanged update the values
    Exit Function
Else
    'step thru the existing links and see if it exists
    For Each Link In lSources
        If Link = oldLinkPathAndFile Then
            '''''''''''''''''''''''''''''''''''''
            For Each SHEET In ThisWorkbook.Worksheets   'this seemingly useless loop handles a bug where if a link is not referenced in the active sheet it crashes
                SHEET.Activate
                On Error Resume Next
                '''''''''''''''''''''''''''''''''''''
                ThisWorkbook.Activate
                ThisWorkbook.ChangeLink Name:=Link, NewName:=newLinkPathAndFile, Type:=xlExcelLinks  'update the link
                UpdateXlsLinkSource = True
                '''''''''''''''''''''''''''''''''''''
                If Err = 0 Then
                    On Error GoTo 0
                    Exit For
                End If
                Next SHEET
            '''''''''''''''''''''''''''''''''''''
            Exit For
        End If
    Next Link
    
    'check if the link was found AND WARN IF IT WAS NOT
    If Not UpdateXlsLinkSource Then
        MsgBox "Link to target not found"
        Exit Function
    End If
    
    If Not theFileIsAlreadyOpen Then    'CHECK IF THE FILE IS CLOSED, IF IT IS THEN OPEN IT
        Workbooks.Open (newLinkPathAndFile)
    End If
End If
End Function

'''''''''''''

自动更改公式

1 个答案: