我使用此代码将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,但在我的每个模板中,该集合都是空的:
我尝试了很多不同的组合,这就是我清理的内容:
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
答案 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
如果您确实需要使用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