Announcement

Collapse
No announcement yet.

Creating PivotTable-reports from VB 6.0

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Creating PivotTable-reports from VB 6.0

    Hi all,

    Creating reports in Excel is a common task and also to retrieve data from databases.

    For several reason we may decide to create a standalone reporttool in VB instead of doing it from inside Excel.

    When setting up reports with the Pivottable and particular if we want to have the option to update the table ( i e retrieve updated data from the source) we must be aware of that there exist certain limitations to use a classic ADO-approach and therefore are (still) forced to use the ODBC-approach.

    Please see Populate pivottables using ADO

    In the example early binding is used and therefore it require that we set references to the following library:

    * Microsoft Excel 9.0 or later

    What we need:
    * Microsoft Visual Basic 6.0
    * Microsoft Excel 2000 and later
    * The example database Northwind.mdb


    Code:
    Option Explicit
    
    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
            
    'If a session of Excel is already running then grab it.
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    
    'Otherwise instantiate a new instance.
    'Keep in mind that no active Add-ins will be available unless they are
    'of the type COM.
    If xlApp Is Nothing Then
        'Set the flag to remember who have started the session.
        bStarted = True
        Set xlApp = New Excel.Application
    End If
    
    'Create a new workbook with one worksheet only.
    Set xlWbook = xlApp.Workbooks.Add(xlWBATWorksheet)
    
    With xlWbook
        Set xlWSheet = .Worksheets(1)
        Set xlptCache = .PivotCaches.Add(SourceType:=xlExternal)
    End With
    
    'Populate the Pivotcache.
    With xlptCache
        .Connection = stCon
        .CommandText = stSQL
        .CommandType = xlCmdSql
    End With
    
    'Create the Pivottable.
    Set xlptTable = xlWSheet.PivotTables.Add( _
                           PivotCache:=xlptCache, _
                           TableDestination:=xlWSheet.Range("D4"), _
                           TableName:="PT_Report")
                            
    'Setup the pivottable.
    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
    
    'Save the created workbook.
    xlWbook.SaveAs stFilename
    
    'If this procedure have started Excel then the UserControl of Excel must be
    'set to True and we need to make Excel visible.
    If bStarted Then
        With xlApp
            .Visible = True
            .UserControl = True
        End With
    End If
    
    'Switch to Excel.
    AppActivate (xlApp)
    
    'Release the objects from memory.
    Set xlptTable = Nothing
    Set xlptCache = Nothing
    Set xlWSheet = Nothing
    Set xlWbook = Nothing
    Set xlApp = Nothing
    
    End Function
    Last edited by XL-Dennis; June 27th, 2005, 07:54.
    Kind regards,
    Dennis

    .NET & Excel | 2nd edition PED | MVP
Working...
X