Skapa Pivottabell-rapporter
Här demonstreras en teknik för att skapa Pivottabell-rapporter i arbetsböcker.
Som framgår av exemplet så kan vi mha av SQL-frågan och hur vi skapar innehållet i Pivottabellen styra vad användarna kan göra. Förfarandet skapar förutsättningar för både flexibla och fasta rapporter.
Option Explicit
'© 2005 Alla rättigheter XL-Dennis
Dim xlApp As Excel.Application
Dim xlWbook As Excel.Workbook
Dim xlWSheet As Excel.Worksheet
Dim xlptCache As Excel.PivotCache
Dim xlptTable As Excel.PivotTable
Const stCon As String = "ODBC;DSN=MS Access Database;" & _
"DBQ=C:\Northwind.mdb;DefaultDir=C:\;" & _
"DriverId=25;FIL=MS Access;" & _
"MaxBufferSize=2048;PageTimeout=5;"
Const stSQL As String = "SELECT ShipCountry, " & _
"COUNT(Freight) AS [# Of Shipments], " & _
"SUM(Freight) AS [Total Freight] " & _
"FROM Orders " & _
"GROUP BY ShipCountry;"
Public Function Create_PivotTable_Report(ByVal stFilename As String)
Dim bStarted As Boolean
'Om en Excel-sejour redan finns så används den.
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
'Om ingen Excel-sejour existerar så skapa en ny.
'Kom ihåg att inga aktiva tilläggsverktyg finns tillgängliga när Excel
'startas på detta sätt.If xlApp Is Nothing Then
'Sätt flaggan till True för att komma ihåg att vi har skapat sejouren.
bStarted = True
Set xlApp = New Excel.Application
End If
'Skapa en ny arbetsbok med ett arbetsblad.
Set xlWbook = xlApp.Workbooks.Add(xlWBATWorksheet)
'Skapa Pivotcachen.
With xlWbook
Set xlWSheet = .Worksheets(1)
Set xlptCache = .PivotCaches.Add(SourceType:=xlExternal)
End With
'Tilldela Pivotcachen värden.
With xlptCache
.Connection = stCon
.CommandText = stSQL
.CommandType = xlCmdSql
End With
'Skapa Pivottabellen.
Set xlptTable = xlWSheet.PivotTables.Add( _
PivotCache:=xlptCache, _
TableDestination:=xlWSheet.Range("D4"), _
TableName:="PT_Report")
'Sätta upp Pivottabellen.
With xlptTable
.ManualUpdate = True
.PivotFields("ShipCountry").Orientation = xlRowField
.PivotFields("# Of Shipments").Orientation = xlDataField
.PivotFields("Total Freight").Orientation = xlDataField
.Format xlTable2
.ManualUpdate = False
.ManualUpdate = True
End With
'Spara den skapade arbetsboken.
xlWbook.SaveAs stFilename
'Om denna procedur har startat Excel måste vi sätta UserControl till True
'samt göra Excel synlig.If bStarted Then
With xlApp
.Visible = True
.UserControl = True
End With
End If
'Växla över till Excel.
AppActivate (xlApp)
'Frigör objekt från minnet.
Set xlptTable = Nothing
Set xlptCache = Nothing
Set xlWSheet = Nothing
Set xlWbook = Nothing
Set xlApp = Nothing
End Function