时间戳

首页 > 解决方案 > 在 VBA 中运行代码时出现运行时错误 438。抱怨“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”

excel - 在 VBA 中运行代码时出现运行时错误 438。抱怨“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”

问题描述

我试图让这段代码工作，目的是在一个 excel 文件中选择一系列超链接的 excel 文件，按下命令按钮并打印它们。我已经设法打印了一次，但在那之后我得到了运行时错误 438。请参阅下面代码中发生错误的行上方的“这是发生错误的地方”。

我是 VBA 的新手，所以如果有人能解释为什么会发生错误并提供解决方案，我将不胜感激。

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

标签： excelvbahyperlink

解决方案

MS word 没有作用。它只是按钮调用的子程序的名称。忽略关于 ms word 的评论，它是 VBA (excel) 中的代码，用于在 Excel 文档中打印超链接的 excel 文档 :) – David44 15 分钟前

你混淆了 MS Excel 和 MS Word？ExcelApp是Excel Application并且您的消息框显示了其他内容MsgBox "Microsoft Word is not installed on this computer....

也是wdDoNotSaveChangesMS Word 常量而不是 MS Excel 常量。我也建议Option Explicit在顶部添加

我还建议不要使用Selection但使用适当的范围对象。如果您仍想使用选择，请检查它是否是有效选择，如下面的代码所示。

这是你正在尝试的吗？（未经测试）

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

避免ExcelApp.Quit从同一个项目中使用。您可能正在处理其他一些工作簿，并且您可能会丢失这些更改。如果您仍想使用它，请注意可能的反作用。

推荐阅读