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

时间:2015-06-20 19:43:56

标签: excel vba excel-vba ms-word word-vba

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

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

这些循环有时会与For Each保持一致,并且不停止地在Fields / InlineShapes上循环(甚至不会增加索引...)。 (我为此添加了DoEvents,它似乎减少了发生的频率... 如果您有解释,那将非常受欢迎!

使用For i = ... to .Count,现在它的功能非常完美,除了Pasted Excel Range之外,它们被更改为相同大小的范围,每次都从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 Graphic Object.hasChart = -1 .Type = 12 .LinkFormat.Type = 8

范围

粘贴为Picture (Windows Metafile).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,它只描述路径和文件,我不知道为什么或如何影响最初选择的范围......

问题回顾: Pasted Excel Range更改为相同大小的范围,每次从A1开始,并在工作簿的活动工作表上

关于如何更新Word链接的任何其他输入将不胜感激!

根据 Andrew Toomey 的回答,我使用HyperLinks,但在我的每个模板中,该集合都是空的:

enter image description here

我尝试了很多不同的组合,这就是我清理的内容:

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

2 个答案:

答案 0 :(得分:2)

可能并非所有的字段/形状都被链接,并且字段/形状的原始插入导致并未在对象上创建所有属性。

为了推进您的代码并更详细地了解对象的问题,请尝试忽略并报告错误。使用手表检查物体。

例如:

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消息)。

答案 1 :(得分:1)

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

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

Sub change_Templ_Args()
    WbkFullname = ActiveWorkbook.FullName

    'Alternatively...
    'WbkFullname = "C:\temp\myworkbook.xlsx"
    'Application.Workbooks.Open Filename:=WbkFullname

    'Get Document filename string
    MyWordDoc = "C\Temp\mysample.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的检查 - 这些链接是文档的内部链接。

'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