使用Access 2003 VBA创建数据透视表后，Excel后台进程未关闭

Question

我想用Access 2003在Excel中创建一个透视表。现在我可以创建一个数据透视表，但后台处理excel还没有结束。结果我的程序只能运行一次。我想知道如何关闭Excel后台进程。

Answer 1

我的代码：

Dim lRET            As Integer
Dim lEXCEL_OBJ      As Excel.Application
Dim lWKB            As Excel.Workbook
Dim lSHEET          As Excel.Worksheet
Dim lSHEET2         As Excel.Worksheet
Dim lFILEFULLNAME   As String
Dim lTEMPLATEFILE   As String
Dim lTEMPLATEPATH   As String
Dim lBUTTON         As String

Dim PTcache         As Excel.PivotCache
Dim PT              As Excel.PivotTable

Dim PRange          As Range
Dim LastRow         As Long
Dim LastCol         As Long

Const lFILE         As String = "template_macro2.xlt"

On Error GoTo EXCEL_RESULT_T_ERROR

lTEMPLATEPATH = "C:Temp" & lFILE

lTEMPLATEFILE = Dir(lTEMPLATEPATH)

Set lEXCEL_OBJ = CreateObject("Excel.Application")
Set lWKB = lEXCEL_OBJ.Workbooks.Add(lTEMPLATEPATH)

With lEXCEL_OBJ
Set lWKB = .Workbooks.Add(lTEMPLATEPATH)
Set lSHEET = .ActiveWorkbook.Sheets(1)
End With

With lEXCEL_OBJ
lWKB.Worksheets.Add
lWKB.ActiveSheet.Name = "test1"
Set lSHEET = .ActiveSheet
End With

With lSHEET
.Range("a:z").ColumnWidth = 10
.Range("b:b").ColumnWidth = 22
.Range("m:m").ColumnWidth = 24
.Range("q:q").ColumnWidth = 50
.Range("u:u").ColumnWidth = 15
End With

'add raw data in excel
Call MAKE_EXPORT_TABLE_DO_OR(lSHEET)

With lEXCEL_OBJ
lWKB.Sheets("Sheet1").Select
lWKB.Worksheets.Add
lWKB.ActiveSheet.Name = "test2"
Set lSHEET2 = .ActiveSheet

'Define Data Range
LastRow = lSHEET.Cells(lSHEET.Rows.COUNT, 1).End(-4162).Row
LastCol = lSHEET.Cells(1, lSHEET.Columns.COUNT).End(-4159).Column
Set PRange = lSHEET.Cells(1, 1).Resize(LastRow, LastCol)
'Create a Pivot Cache
Set PTcache = ActiveWorkbook.PivotCaches.Add(xlDatabase, PRange)
'Create the Pivot Table from the Cache
Set PT = PTcache.CreatePivotTable(TableDestination:=Sheets("test2").Cells(1, 1))
End With

lWKB.SaveAs hFULLPATH
EXCEL_RESULT_T_EXIT:
On Error Resume Next
lWKB.Close
PT.Application.Quit
lEXCEL_OBJ.Application.Quit
Set lWKB = Nothing
Set lEXCEL_OBJ = Nothing
Application.Echo True
DoCmd.Hourglass False
Exit Function
EXCEL_RESULT_T_ERROR:
Resume EXCEL_RESULT_T_EXIT