Question

我有一个例程，可以将任何记录集从MS Access数据库粘贴到现有工作簿中。代码第一次运行正常，但我永远不会运行它两次因为它在任务管理器中运行了一个Excel实例。当然，当我在我的代码中引用第二，第三等时间的Excel对象时，这会导致错误，因为对象是不明确的。

为了丢失任何东西，这里是整个代码：

'I call the routine like so: 



 Private Sub cmdGenerateRpt
    Dim strPath As String
        strPath = "C:\Test\MyReport.xlsx"

        Call PushToExistingExcel("MAIN SHEET", strPath)

    End sub


    Public Sub PushToExistingExcel(strSheetToPlaceData As String, strPathToWorkbook As String)
    'Puts a recordset into a specific cell of an Excel workbook
    Dim xlApp As Object
    Dim wb As Object
    Dim xlSheet As Object
    Dim rs As DAO.Recordset
    Dim rsTotals As DAO.Recordset
    Dim x As Integer
    Dim fld As Variant
    Dim intRecords As Integer
    Dim intTotals As Integer

    Set xlApp = CreateObject("Excel.Application")
    Set wb = xlApp.Workbooks.Open(strPathToWorkbook)


    Set xlSheet = wb.Sheets(strSheetToPlaceData) 'or you can manually type the sheet name in place of strSheetToPlaceData

    Set rs = CurrentDb.OpenRecordset("Select * from qryRPT")
    Set rsTotals = CurrentDb.OpenRecordset("Select * from qryTOTALS")


    intRecords = rs.RecordCount
    intTotals = intRecords + 3

    xlSheet.Select
    xlSheet.Range("A3:AH3").Select
    xlSheet.Range(Selection, Selection.End(xlDown)).Select

    'PLACE
    xlSheet.Range("A3").CopyFromRecordset rs
    xlSheet.Range("L" & intRecords + 3).CopyFromRecordset rsTotals

    Cells.EntireColumn.AutoFit
    xlSheet.Range("A1").Select

        Range("A" & intTotals & ":AH" & intTotals).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

        With Selection.Font
            .Name = "Calibri"
            .FontStyle = "Bold"
            .Size = 11
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0

        End With
        Selection.NumberFormat = "$#,##0.00"
        Range("A" & intTotals).Value = "TOTALS"

    wb.Save
    MsgBox "Done"

    xlApp.Visible = True

    'If I use xlApp.quit it quits, but still leaves it running in task manager

    Set wb = Nothing
    Set xlSheet = Nothing
    Set rs = Nothing
    Set rsTotals = Nothing
    Set xlApp = Nothing

    End Sub

在一天结束时，我希望完成的工作簿能够向用户展示自己。没有理由只说报告已经完成 - ＆＃39;去寻找它＆＃39; 但我似乎无法弄清楚如何摆脱VBA留下的Excel实例。

Answer 1

为了成功清理，您需要

销毁引用Excel App中对象的所有对象
关闭所有工作簿
退出应用

此外，为了避免任何错误并创建更清晰的代码，您应该

避免使用隐式ActiveSheet。对Cells. ...，Range( ...，Selection. ... 的无限制引用可能将引用Excel应用程序挂起。使用所有引用
避免Select，Selection等

See this answer有关避免这些

清理代码应为

Set xlSheet = Nothing
For Each wb In xlApp.Workbooks
    wb.Close False
Next
xlApp.Quit
Set xlApp = Nothing

Answer 2

这个更贴近气密。＆＃39;除了避免使用＆＃39;。选择＆＃39;或者＆＃39;。选择像细胞一样的任何迷路引用.EntireColumn.AutoFit对我来说是一个陷阱。

请注意我是如何坚持使用Excel的3个变量的 - xlApp，wb和xlSheet 我使用的任何引用都需要所有这三个紧密集成完整地址。我还使用了＆＃39; Late Binding。＆＃39;

然后我在另一个例程中分离了工作簿的表示。

以此为例，将复杂查询粘贴到指定位置的现有工作簿并显示报表。它工作得很好！

Public Sub PushToExistingExcel(strSheetToPlaceData As String, strPathToWorkbook As String)

'Puts a recordset into a specific cell of an Excel workbook
Dim xlApp As Object
Dim wb As Object
Dim xlSheet As Object


Dim rs As DAO.Recordset
Dim rsTotals As DAO.Recordset
Dim x As Integer
Dim fld As Variant

Dim intRecords As Integer
Dim intTotals As Integer

Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(strPathToWorkbook)

Set xlSheet = wb.Sheets(strSheetToPlaceData) 'or you can manually type the sheet name in place of strSheetToPlaceData

Set rs = CurrentDb.OpenRecordset("Select * from qryRPT")
Set rsTotals = CurrentDb.OpenRecordset("Select * from qryTOTALS")


intRecords = rs.RecordCount
intTotals = intRecords + 3

xlSheet.Rows("3:" & xlSheet.Rows.Count).ClearContents

'PLACE

With xlSheet
.Range("A3").CopyFromRecordset rs
.Range("L" & intRecords + 3).CopyFromRecordset rsTotals
.Cells.EntireColumn.AutoFit
End With


With xlSheet.Range("A" & intTotals & ":AH" & intTotals).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

With xlSheet.Range("A" & intTotals & ":AH" & intTotals).Font
    .Name = "Calibri"
    .FontStyle = "Bold"
    .Size = 11
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0

End With

xlSheet.Range("A3:AH" & intTotals).NumberFormat = "$#,##0.00"
xlSheet.Range("A" & intTotals).Value = "TOTALS"

wb.Save

'cleanup
Set xlSheet = Nothing
For Each wb In xlApp.Workbooks
    wb.Close False
Next

Set rs = Nothing
Set rsTotals = Nothing

xlApp.Quit
Set xlApp = Nothing

MsgBox "Report Complete"
PresentExcel (strPathToWorkbook)

End Sub

Public Sub PresentExcel(strPath As String)
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True

    xlApp.Workbooks.Open strPath
    Debug.Print xlApp.Version
    Set xlApp = Nothing

End Sub

在VBA中使用后处置Excel

2 个答案: