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

Question

我使用此代码来将 Word 模板中所有链接的字段/图表/...的源更改为启动它的工作簿。

我有常用字段和图表(存储在InlineShapes中)，因此每个模板都有 2 个循环。

<小时/>

这些循环有时会卡在For Each上，并在Fields/InlineShapes上继续循环(甚至不增加索引.. 。) 不停止。 (我为此添加了 DoEvents，它似乎减少了发生这种情况的频率...如果您有解释，我们将非常欢迎!)

对于For i = ... to .Count，现在它的工作几乎完美无缺，除了粘贴的Excel范围被更改为一个范围大小相同，每次从 A1 开始，并在工作簿的事件工作表上。

<小时/>

为了避免 InlineShapes 出现问题，我添加了一个测试来了解 LinkFormat.SourceFullName 是否可访问，从而避免出现导致进程停止的错误:

Function GetSourceInfo(oShp As InlineShape) As Boolean
Dim test As Variant
    On Error GoTo Error_GetSourceInfo
    test = oShp.LinkFormat.SourceFullName
    GetSourceInfo = True
    Exit Function
Error_GetSourceInfo:
   GetSourceInfo = False
End Function

<小时/>

我在模板中注意到了两种类型的链接 InlineShapes :

图表

粘贴为 Microsoft Office 图形对象:.hasChart = -1.类型 = 12.LinkFormat.Type = 8

范围

粘贴为图片(Windows 图元文件):.hasChart = 0.Type = 2.LinkFormat.Type = 0

这是我的 InlineShapes 循环:

For i = 1 To isCt
    If Not GetSourceInfo(oDoc.InlineShapes(i)) Then GoTo nextshape
        oDoc.InlineShapes(i).LinkFormat.SourceFullName = NewLink
        DoEvents
nextshape:
Next i

问题

由于我只更新 .SourceFullName，它只描述路径和文件，我不知道为什么或如何影响最初选择的范围...

问题回顾:粘贴的 Excel 范围 更改为相同大小的范围，每次从 A1 开始，并在事件工作表上工作簿。

任何有关如何更新 Word 链接的其他意见将不胜感激!

<小时/>

正如Andrew Toomey的回答中所建议的，我使用了超链接，但在我的每个模板中，集合都是空的:

<小时/>

我尝试了很多不同的组合，以下是我清理的内容:

Sub change_Templ_Args()

Dim oW As Word.Application, _
    oDoc As Word.Document, _
    aField As Field, _
    fCt As Integer, _
    isCt As Integer, _
    NewLink As String, _
    NewFile As String, _
    BasePath As String, _
    aSh As Word.Shape, _
    aIs As Word.InlineShape, _
    TotalType As String

On Error Resume Next
Set oW = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set oW = CreateObject("Word.Application")
On Error GoTo 0
oW.Visible = True

NewLink = ThisWorkbook.Path & "\" & ThisWorkbook.Name

BasePath = ThisWorkbook.Path & "\_Templates\"
NewFile = Dir(BasePath & "*.docx")

Do While NewFile <> vbNullString
    Set oDoc = oW.Documents.Open(BasePath & NewFile)
    fCt = oDoc.Fields.Count
    isCt = oDoc.InlineShapes.Count
    MsgBox NewFile & Chr(13) & "Fields : " & oDoc.Fields.Count & Chr(13) & "Inline Shapes : " & isCt

    For i = 1 to fCt 
        With oDoc.Fields(i)
            '.LinkFormat.AutoUpdate = False
            'DoEvents
            .LinkFormat.SourceFullName = NewLink
            '.Code.Text = Replace(.Code.Text, Replace(.LinkFormat.SourceFullName, "\", "\\"), Replace(NewLink, "\", "\\"))
        End With
    Next i

    For i = 1 To isCt
        If Not GetSourceInfo(oDoc.InlineShapes(i)) Then GoTo nextshape
            With oDoc.InlineShapes(i)
                .LinkFormat.SourceFullName = NewLink
                DoEvents
                'MsgBox .LinkFormat.SourceFullName & Chr(13) & Chr(13) & _
                        "Type | LF : " & .LinkFormat.Type & Chr(13) & _
                        "Type | IS : " & .Type & Chr(13) & _
                        "hasChart : " & .HasChart & Chr(13) & Chr(13) & _
                        Round((i / isCt) * 100, 0) & " %" 
            End With
nextshape:
    Next i

    MsgBox oDoc.Name & " is now linked with this workbook!"
    oDoc.Save
    oDoc.Close
    NewFile = Dir()
Loop
oW.Quit

Set oW = Nothing
Set oDoc = Nothing

MsgBox "All changes done.", vbInformation + vbOKOnly, "End proc"

End Sub

Answer 1

也许并非所有字段/形状都是链接的，并且字段/形状的原始插入导致并非在对象上创建所有属性。

要改进您的代码并更详细地了解对象的问题，请尝试忽略并报告错误。使用 watch 检查物体。

例如:

On Error Goto fieldError
For Each aField In oDoc.Fields
    With aField
        .LinkFormat.AutoUpdate = False
        DoEvents
        .LinkFormat.SourceFullName = NewLink
        .Code.Text = Replace(.Code.Text, Replace(.LinkFormat.SourceFullName, "\", "\\"), Replace(NewLink, "\", "\\"))
        Goto fieldContinue
      fieldError:
        MsgBox "error: <your info to report / breakpoint on this line>"
      fieldContinue:
    End With
Next aField

P.s.:DoEvents 的目的是什么？这将处理外部事件(Windows 消息)。