且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

更改 Word 文档中所有链接的来源 - 范围错位

更新时间:2023-02-18 11:16:32

我认为使用 hyperlinks 集合是解决方案的关键 - 除非您有特定的理由不这样做.从 Word 文档到 Excel 工作簿的链接是外部链接,因此都应列在 Hyperlinks 集合中(无论它们是文本链接还是链接的 InlineShapes).

I think using the hyperlinks collection is the key to your solution - unless you have a specific reason not to. Links from a Word document to an Excel workbook are external links so should all be listed in the Hyperlinks collection (regardless of whether they are text links or InlineShapes that are linked).

这是我的代码,可能会有所帮助.为简单起见,我对 Word 文档进行了硬编码,因为这对您来说不是问题:

Here's my code that may be of some help. For simplicity I've hard coded the Word document since that's not an issue for you:

Sub change_Templ_Args()
    WbkFullname = ActiveWorkbook.FullName

    'Alternatively...
    'WbkFullname = "C:	empmyworkbook.xlsx"
    'Application.Workbooks.Open Filename:=WbkFullname

    'Get Document filename string
    MyWordDoc = "CTempmysample.docx"

    Set oW = CreateObject("Word.Application")
    oW.Documents.Open Filename:=MyWordDoc 
    Set oDoc = oW.ActiveDocument

    'Reset Hyperlinks
    For Each HypLnk In oDoc.Hyperlinks
        HypLnk.Address = WbkFullname
    Next

End Sub

如果你真的需要使用 FieldsInlineShapes 试试这个代码.我在 For 循环中使用了变体,并为目录或交叉引用字段的字段添加了对 wdLinkTypeReference 的检查 - 这些链接是文档内部的.

If you really need to use Fields and InlineShapes try this code. I've used variants in For loop and added a check for wdLinkTypeReference for fields that are Table of Contents or Cross Reference fields - these links are internal to the document.

'Reset links to InlineShapes
For Each InShp In ActiveDocument.InlineShapes
    If Not InShp.LinkFormat Is Nothing Then
        InShp.LinkFormat.SourceFullName = WbkFullname
    End If
    If InShp.Hyperlink.Address <> "" Then
        InShp.LinkFormat.SourceFullName = WbkFullname
    End If
Next

'Reset links to fields
For Each Fld In ActiveDocument.Fields
    If Not Fld.LinkFormat Is Nothing Then
        If Fld.LinkFormat.Type <> wdLinkTypeReference Then 
            Fld.LinkFormat.SourceFullName = WbkFullname
        End If
    End If
Next