excel - Word VBA:更新 OLE 源链接
问题描述
我的 word 文档中有大约十几个链接的 excel OLE 对象。这些文件经常在网络上移动,所以我需要一种简单直观的方法来更新底层链接。我尝试了在此网站上找到的代码,但是在更新源代码的同时,它似乎也更新了对象本身中显示的内容,因此所有对象都更改为上次保存 excel 工作簿时关注的任何工作表。我试图在更新源代码时保留格式和范围。任何帮助都会很棒。
这是我目前尝试的代码:
Private Sub CommandButton1_Click()
Dim OldFile As String
Dim xlsobj As Object
Dim xlsfile_chart As Object
Dim dlgSelectFile As FileDialog 'FileDialog object '
Dim thisField As Field
Dim selectedFile As Variant
'must be Variant to contain filepath of selected item
Dim newFile As Variant
Dim fieldCount As Integer '
Dim x As Long
On Error GoTo LinkError
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog
(FileDialogType:=msoFileDialogFilePicker)
With dlgSelectFile
.Filters.Clear 'clear filters
.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm,*.xlsx" 'filter
for only Excel files
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
newFile = selectedFile 'gets new filepath
Next selectedFile
Else 'user clicked cancel
Exit Sub
End If
End With
Set dlgSelectFile = Nothing
'update fields
Set xlsobj = CreateObject("Excel.Application")
xlsobj.Application.Visible = False
Set xlsfile_chart = xlsobj.Application.Workbooks.Open(newFile, ReadOnly =
True)
Application.ScreenUpdating = False
With xlsobj.Application
.calculation = xlcalculationmanual
.enableevents = False
End With
fieldCount = ActiveDocument.Fields.Count
For x = 1 To fieldCount
With ActiveDocument.Fields(x)
If .Type = 56 Then
.LinkFormat.SourceFullName = newFile
End If
End With
Next x
With xlsobj.Application
.calculation = xlcalculationmanual
.enableevents = True
End With
Application.ScreenUpdating = True
MsgBox "Data has been sucessfully linked to report"
'clean up
xlsfile_chart.Close SaveChanges:=False
Set xlsfile_chart = Nothing
xlsobj.Quit
Set xlsobj = Nothing
Exit Sub
LinkError:
Select Case Err.Number
Case 5391 'could not find associated Range Name
MsgBox "Could not find the associated Excel Range Name " & _
"for one or more links in this document. " & _
"Please be sure that you have selected a valid " & _
"Quote Submission input file.", vbCritical
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Select
' clean up
Set xlsfile_chart = Nothing
xlsobj.Quit
Set xlsobj = Nothing
End Sub
解决方案
推荐阅读
- flutter - 如何添加一个按钮以显示在 listview.builder 的末尾
- java - INSTALL_FAILED_MISSING_SHARED_LIBRARY 导致应用无法安装
- c# - IP 摄像机视频流纹理未提供给 Unity
- mongodb - Kubernetes MongoDb pod 内存使用差异
- oop - 将 Dart 枚举放入类或包导出文件中
- javascript - 简单的 HXR 请求返回 mysql 响应
- angular - 如何使用来自另一个组件的 onclick 事件更改 iframe src(角度)
- linux - ps -ef 命令未找到 shell 脚本
- java - 使用 Workday 的 SOAP API
- objective-c - 防止向 tableview 添加阴影以防止隐藏行在 Objective-C 或 Swift 中显示