Dim strFileName As String
Dim xlApp As Object
Dim wb1 As Workbook
Dim xlRng As Object
Dim strRange As String
Dim dbase As Database
Dim intColumnCount As Integer
Dim intRecordCount As Integer
Private Sub Command2_Click()
On Error GoTo Command2_Click_Err
Set dbase = CurrentDb
intColumnCount = dbase.QueryDefs("Qry1").Fields.Count
Set dbase = Nothing
intRecordCount = DCount("[Report_Category]", "Qry1") + 1
strFileName = "Test PivotTable " & DatePart("m", Date) & "_" & IIf(DatePart("d", Date) < 10, "0" & DatePart("d", Date), DatePart("d", Date))
DoCmd.OutputTo acOutputQuery, "Qry1", "xlsx", Environ$("USERPROFILE") & "\documents\" & strFileName & ".xlsx"
'Set xlApp = New Excel.Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
End If
'xlApp.Visible = True
Set wb1 = xlApp.Workbooks.Open(Environ$("USERPROFILE") & "\documents\" & strFileName & ".xlsx")
'Determine total data being used, rows and columns
strRange = "Qry1!R1C1:R" & intRecordCount & "C" & intColumnCount
wb1.Sheets.Add
wb1.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
strRange, Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion12
wb1.Sheets(1).Select
wb1.Sheets(1).Cells(1, 1).Select
wb1.Sheets(1).Shapes.AddChart.Select
wb1.Sheets(1).Shapes(1).Chart.ChartType = xlLineMarkers
Set xlRng = wb1.Sheets(1).Range("A1:C18")
With wb1.Sheets(1).Shapes(1).Chart
.SetSourceData xlRng
End With
With wb1.Sheets(1).Shapes(1)
.IncrementLeft 192
.IncrementTop 14.4
End With
wb1.Sheets(1).PivotTables("PivotTable1").AddDataFi eld wb1.Sheets(1).PivotTables( _
"PivotTable1").PivotFields("Tran_Amount"), "Sum of Tran_Amount", xlSum
With wb1.Sheets(1).PivotTables("PivotTable1").PivotFiel ds("Period")
.Orientation = xlRowField
.Position = 1
End With
With wb1.Sheets(1).PivotTables("PivotTable1").PivotFiel ds("Report_Category")
.Orientation = xlColumnField
.Position = 1
End With
wb1.ShowPivotTableFieldList = False
wb1.Sheets(1).Shapes(1).Chart.Parent.Cut
wb1.Sheets.Add
wb1.Sheets(1).Paste
wb1.Close (True)
xlApp.Quit
Set wb1 = Nothing
Set xlApp = Nothing