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