Измените источники всех ссылок в документе 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
, которые описывают только Path и File, я не знаю, почему и как это влияет на первоначально выбранный диапазон...
Резюме проблемы: 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
Ответы
Ответ 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
Если вам действительно нужно использовать Fields
и InlineShapes
, попробуйте этот код. Я использовал варианты в цикле For и добавил проверку для wdLinkTypeReference
для полей, которые являются оглавлениями или полями Cross Reference - эти ссылки являются внутренними для документа.
'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
Ответ 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).