更改Word文档中的所有链接的来源 - 错误的范围 [英] Change all links' sources in a Word document - Misplacement of Ranges
问题描述
我使用此代码将
我有常规字段和图表（存储在 InlineShapes ）中，所以我有2每个模板的循环。
这些循环有时保持卡住 For Each ，并继续循环 Fields / InlineShapes （甚至不要增加索引...）而不停止。 （我添加了 DoEvents ，似乎减少了发生的频率... 如果你有一个解释，这将是非常欢迎！
与对于i = ...到.Count ，现在它几乎工作完美无缺，除已粘贴Excel范围之外，将其更改为相同大小的范围，从 A1 每次，以及工作簿的活动工作表。
为避免 InlineShapes ，我添加了一个测试，以确定是否可以访问 LinkFormat.SourceFullName ，因此避免了会导致该过程停止的错误： p>
函数GetSourceInfo（oShp As InlineShape）As Boolean
Dim test As Variant
错误GoTo Error_GetSourceInfo
test = oShp.LinkFormat.SourceFullName
GetSourceInfo = True
退出函数
Error_GetSourceInfo：
GetSourceInfo = False
E nd函数
我注意到两种链接的code> InlineShapes 在我的模板中：
图表
粘贴为 Microsoft Office图形对象：
.hasChart = -1
。键入 = 12
.LinkFormat.Type = 8
范围
粘贴为图片（Windows图元文件）：
.hasChart = 0
.Type = 2
.LinkFormat.Type = 0
这是我的循环 InlineShapes ：
对于i = 1到isCt
如果不是GetSourceInfo（oDoc.InlineShapes（i））然后GoTo nextshape
oDoc.InlineShapes（i）.LinkFormat.SourceFullName = NewLink
DoEvents
nextshape：
Next i
问题
由于我只更新了仅描述路径和文件的 .SourceFullName ，我没有线索为什么或如何影响最初选择的范围...
问题回顾： 粘贴的Excel范围每次更改为相同大小的范围，从 A1 开始，并在工作簿的活动工作表上。
任何其他输入如何更新Word链接将不胜感激！
如
https://i.stack.imgur.com/gYRhp.pngalt =在此输入图像说明>
我尝试了很多不同的组合，这里是我清理的：
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，_
NewFil e As String，_
BasePath As String，_
aSh As Word.Shape，_
aIs As Word.InlineShape，_
TotalType As String
On Error Resume Next
设置oW = GetObject（，Word.Application）
如果Err.Number<> 0然后设置oW = CreateObject（Word.Application）
错误GoTo 0
oW.Visible = True
NewLink = ThisWorkbook.Path& \& ThisWorkbook.Name
BasePath = ThisWorkbook.Path& \_Templates\
NewFile = Dir（BasePath&* .docx）
尽管NewFile<> vbNullString
设置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形状：& isCt
对于i = 1到fCt
与oDoc.Fields（i）
'.LinkFormat.AutoUpdate = False
'DoEvents
.LinkFormat。 SourceFullName = NewLink
'.Code.Text = Replace（.Code.Text，Replace（.LinkFormat.SourceFullName，\，\\），替换（NewLink，\ \\））
结束
下一步i
对于i = 1 ToCet
如果不是GetSourceInfo（oDoc.InlineShapes（i））然后GoTo nextshape
与oDoc.InlineShapes（i）
.LinkFormat.SourceFullName = NewLink
DoEvents
'MsgBox .LinkFormat.SourceFullName& Chr（13）& Chr（13）& _
Type | LF：& .LinkFormat.Type& Chr（13）& _
Type | IS：& 。类型& Chr（13）& _
hasChart：&哈司图Chr（13）& Chr（13）& _
Round（（i / isCt）* 100，0）& ％
End with
nextshape：
Next i
MsgBox oDoc.Name& 现在与这本工作簿联系起来！
oDoc.Save
oDoc.Close
NewFile = Dir（）
循环
oW.Quit
设置oW = Nothing
设置oDoc = Nothing
MsgBox所有更改完成，vbInformation + vbOKOnly，End proc
End Sub
也许不是所有的字段/形状都被链接，原始的字段/形状的插入导致不是所有的属性在对象上创建。
要提高代码并更详细地了解对象的问题，请尝试忽略并报告错误。用手表检查物体。
例如：
On Error Goto fieldError
对于每个aField在oDoc.Fields
与aField
.LinkFormat.AutoUpdate = False
DoEvents
.LinkFormat.SourceFullName = NewLink
.Code.Text = Replace（。 Code.Text，Replace（.LinkFormat.SourceFullName，\，\\），替换（NewLink，\，\\））
转到fieldContinue
fieldError：
MsgBox错误：<您要在此行上报告/断点的信息>
fieldContinue：
结束
下一个aField
Ps：什么是 DoEvents 的目的？这将处理外部事件（Windows消息）。
I work on this code to change the sources of all linked Fields/Charts/... in Word templates to the workbook it is launched from.
I had usual fields and charts (which are stored in InlineShapes), so I have 2 loops for every template.
These loops sometimes stays stuck with For Each, and keep looping on Fields/InlineShapes (and don't even increase index...) without stopping. (I added the DoEvents for that, and it seems to reduce the frequency of that happening... if you have an explanation, it'll be very welcome!)
And with For i = ... to .Count, now it works pretty much flawlessly, except for Pasted Excel Range which are changed to a range of the same size, starting on A1 each time, and on the active sheet of the workbook.
To avoid problems with InlineShapes, I added a test to know if the LinkFormat.SourceFullName is accessible and therefore avoid an error that would stop the process :
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
I noted 2 types of linked InlineShapes in my templates :
Charts
Pasted as Microsoft Office Graphic Object :
.hasChart = -1
.Type = 12
.LinkFormat.Type = 8
Ranges
Pasted as Picture (Windows Metafile) :
.hasChart = 0
.Type = 2
.LinkFormat.Type = 0
Here is my loop for 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
Question
As I only update the .SourceFullName, which only describe Path and File, I have no clue on why or how this affect the initially selected range...
Problem recap : Pasted Excel Range which are changed to a range of the same size, starting on A1 each time, and on the active sheet of the workbook.
And any other inputs on how to update Word links will be appreciated!
As suggested in Andrew Toomey's answer, I worked with HyperLinks but in each one of my templates, the collection is empty :
I've tried quite a lot of different combinations and here is what I cleaned :
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
Maybe not all Fields/Shapes are linked and the original insert of the field/shape resulted in not all properties being created on the object.
To advance your code and find out in more detail what is the matter with the objects, try to ignore and report errors. Use watches to inspect the objects.
For example:
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.: what is the purpose of DoEvents? That will process external events (Windows messages).
这篇关于更改Word文档中的所有链接的来源 - 错误的范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
