|
|
在WORD中使用LINK域的都知道，如果被链接的Excel文件的存放位置发生变化，更新域后就会出现错误，有什么办法呢？
经过反复研究守柔版主的域代码相关知识及《Word非常接触》后，写了如后的代码，并测试成功，现与广大域代码爱好者分享。
要求：
一、插入域代码时，不要加“\a”开关（不自动更新）；
二、设置Word选项，使之打开时不自动更新域（Word选项－>高级－>常规－>打开时更新自动链接：不勾选）。
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By qxnljx, 2012-5-23 23:15
'仅测试于System: Windows 7 Word: 14.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub AutoOpen()
If MsgBox("是否进行数据更新？", vbQuestion + vbYesNo + vbDefaultButton2, "温馨提示") = vbYes Then
Application.ScreenUpdating = False
Call UpdateLinkPath
Application.ScreenUpdating = True
End If
End Sub
Private Sub UpdateLinkPath()
'默认：链接表与Word文档在同一目录下
Dim UserFileName As Variant
Dim fd As FileDialog
Dim sField, c, cPath As String
Dim i, n As Integer
ActiveDocument.Fields(1).Select
sField = ActiveDocument.Fields(1).Code
i = InStr(1, sField, "房产销售与客户关系管理系统.xls", vbTextCompare)
If i > 0 Then
For n = 1 To i
c = Mid(sField, n, 1)
If c = ":" Then
cPath = Mid(sField, n - 1, i - n + 1)
If Dir(VBA.Replace(cPath, "\\", "\") & "房产销售与客户关系管理系统.xls", vbDirectory) = "" Then '当前目录下指定的表不存在
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
UserFileName = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
If UserFileName <> False Then
If InStr(1, UserFileName, "房产销售与客户关系管理系统.xls", vbTextCompare) > 0 Then
Call FindandReplace(cPath, VBA.Replace(Mid(UserFileName, 1, InStr(1, UserFileName, "房产销售与客户关系管理系统.xls", vbTextCompare) - 1), "\", "\\"))
Else
MsgBox "您打开的文件不是指定的表格文件！"
Exit Sub
End If
Else
MsgBox "您没有打开任何表格文件！"
Exit Sub
End If
Else '当前目录下指定的表存在
If StrComp(VBA.Replace(cPath, "\\", "\"), ThisDocument.Path & "\", vbTextCompare) <> 0 Then
'链接中的路径不是当前目录
Call FindandReplace(cPath, VBA.Replace(ThisDocument.Path & "\", "\", "\\"))
End If
End If
Exit For
End If
Next
End If
ActiveDocument.Fields.Update '执行更新动作
End Sub
Private Function FindandReplace(FindText As String, ReplaceText As String) As String
Selection.WholeStory
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes '显示所有的域代码(切换方式):One Times!
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = FindText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes '显示所有的域结果(切换方式):Two Times!
End Function
注：默认Word档中的所有Link域均链接于同一个excel表。
欢迎测试，并发表您的测试结果。
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-5-23 23:26
楼主
