更新Word文档中的所有Excelembedded式链接
感谢尼克我试过，但我要指定的Excel应用程序，因为这是在词VBA工作。 我也削减了代码，只改变了链接，但仍然很慢。 我不能理解，因为当我只更新使用的链接
Activedocument.fields.update 它立即完成。 我知道这只是更新和不改变源，但仍然是时间差太大。
我的完整代码是：
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
添加这个：
Application.ScreenUpdating=False With Application .Calculation = xlCalculationManual .EnableEvents = False End With 'Your code here. With Application .Calculation = xlCalculationAutomatic .EnableEvents = True End With Application.ScreenUpdating=True