Изменить источники всех ссылок в документе Word - Смещение диапазонов

Я работаю над этим кодом, чтобы изменить источники всех связанных полей / диаграмм /... в шаблонах 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

Я отметил 2 типа связанных 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, будут оценены!

Как указывалось в ответе Эндрю Туми, я работал с HyperLinks, но в каждом из моих шаблонов коллекция пуста:

Я пробовал довольно много разных комбинаций, и вот что я убрал:

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 ответа

Решение

Я думаю, используя 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

Если вам действительно нужно использовать Fields а также InlineShapes попробуйте этот код. Я использовал варианты в цикле 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
Источник

Возможно, не все поля / фигуры связаны, и оригинальная вставка поля / фигуры привела к тому, что не все свойства были созданы для объекта.

Чтобы усовершенствовать свой код и узнать более подробно, что происходит с объектами, постарайтесь игнорировать и сообщать об ошибках. Используйте часы, чтобы осмотреть объекты.

Например:

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

Ps: какова цель DoEvents? Это будет обрабатывать внешние события (сообщения Windows).

Источник
Другие вопросы по тегам