在VBA中运行代码时获取运行时错误438。投诉“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”
我正在尝试让这段代码正常工作,目的是在excel文件中选择一系列超链接excel文件,按下命令按钮并打印它们。我已经设法打印了一次,但在那之后,我得到了运行时错误438。请参见下面发生错误的代码行上方发生错误的位置 我是VBA新手,如果有人能解释错误发生的原因并提供解决方案,我将不胜感激在VBA中运行代码时获取运行时错误438。投诉“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”,excel,vba,hyperlink,Excel,Vba,Hyperlink,我正在尝试让这段代码正常工作,目的是在excel文件中选择一系列超链接excel文件,按下命令按钮并打印它们。我已经设法打印了一次,但在那之后,我得到了运行时错误438。请参见下面发生错误的代码行上方发生错误的位置 我是VBA新手,如果有人能解释错误发生的原因并提供解决方案,我将不胜感激 Sub ExportToWordAndPrint() With Sheets("SOBar") Const Ttl As String = "Excel Print" Dim cell As Range D
Sub ExportToWordAndPrint()
With Sheets("SOBar")
Const Ttl As String = "Excel Print"
Dim cell As Range
Dim rng As Range
Dim FullNameOfFile As String
Dim ExcelApp As Object, MyDoc As Object
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set ExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
If ExcelApp Is Nothing Then
MsgBox "Microsoft Word is not installed on this computer - operation cancelled.", vbCritical +
vbOKOnly, Ttl
Exit Sub
End If
ExcelApp.Visible = True
Set rng = Selection
For Each cell In rng
With rng
On Error Resume Next
FullNameOfFile = ""
FullNameOfFile = cell.Hyperlinks(1).Address
On Error GoTo 0
If FullNameOfFile <> "" Then 'cell may not have contained a Hyperlink
If Dir(FullNameOfFile) <> "" Then 'cell may contain a Hyperlink, but the file itself may not exist
'Debug.print cell.address & " should print" 'THIS ONE ADDED
With ExcelApp
Set MyDoc = .Workbooks.Open(Filename:=FullNameOfFile)
MyDoc.PrintOut
Application.Wait (Now() + TimeValue("0:00:1"))
.ActiveWindow.Close SaveChanges:=False
End With
Else 'THIS ONE ADDED
'Debug.Print cell.Address & " failed, appears to have wrong filename"
End If
Else 'THIS ONE ADDED
'Debug.Print cell.Address & " failed, appears to have no hyperlink"
End If
End With
Next cell
'This is where error occur
ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges
Set ExcelApp = Nothing
End With
End Sub
word没有角色。它只是按钮调用的子程序的名称。忽略有关ms word的注释,这是VBA excel中的一个代码,用于打印excel文档中的超链接excel文档:–15分钟前的David44
你把MS Excel和MS Word弄混了?ExcelApp是Excel应用程序,您的消息框显示此计算机上未安装其他MsgBox Microsoft Word
另外,WDDONOTSAVECHANGS是MS Word常量,而不是MS Excel常量。我建议在顶部也添加OptionExplicit
我还建议不要使用选择,而是使用适当的范围对象。如果仍要使用该选择,请检查它是否为有效选择,如下面的代码所示
这就是你想要的吗?未经测试
避免使用ExcelApp。从同一项目中退出。您可能正在处理其他工作簿,可能会丢失这些更改。如果您仍然想使用它,请注意可能的重新循环。您好!不,我没有混淆word和excel。我从一个朋友那里得到了代码,他认为我需要打印超链接word文档,然后将其修改为excel。我想使用选择,因为我工作的文档中有~3000个超链接。我已经编辑了我的答案。这就是您正在尝试的吗?您是从Excel还是Word运行此代码?谢谢您的回答:但这是针对Excel文件中的超链接Excel文件,我想使用“选择和命令”按钮打印。我试图将constwddonotsavechanges添加为Integer=0和optionexplicit,但随后我得到了其他bug Range=Nothing。我可能需要多练习一些基础知识……您从哪里运行此代码?从Excel运行此代码:那么Word在这方面扮演什么角色?
Option Explicit
Sub Sample()
Dim ws As Worksheet, wb As Workbook
Dim rng As Range, aCell As Range
Dim FullNameOfFile As String
'~~> Use this object with the right range object
'~~> instead of using `Selection`
Set ws = ThisWorkbook.Sheets("SOBar")
'~~> Instead of selection use something like this
'~~> Change it to the relevant range
'Set rng = ws.Range("A1:A10")
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
For Each aCell In rng
FullNameOfFile = ""
On Error Resume Next
FullNameOfFile = aCell.Hyperlinks(1).Address
On Error GoTo 0
If FullNameOfFile <> "" Then
If Dir(FullNameOfFile) <> "" Then
Set wb = Workbooks.Open(FullNameOfFile)
wb.PrintOut
DoEvents
wb.Close (False)
End If
End If
Next aCell
End Sub