The CreatePIVOTTable Function

When you click the Show button on the Pivot toolbar, the application runs the CreatePIVOTTable function, which creates a Microsoft Excel pivot table. The CreatePIVOTTable function (shown below) performs six main tasks:

It performs typical start-up tasks, such as declaring variables.
It calls the CheckConnect subroutine, which ensures that the ODBC connection string points to Pivot.MDB's current path. (This routine uses the Windows API GetPrivateProfileString and WritePrivateProfileString functions; see Chapter 6 of Developing Applications with Microsoft Office for more information on these functions. See Chapter 5 of Developing Applications with Microsoft Office for more information on ODBC.)
It checks to see whether Microsoft Excel is open and if it is, the function creates a workbook for the pivot table using the existing instance of Microsoft Excel. Otherwise, it launches Microsoft Excel. (This prevents users from opening two copies of Microsoft Excel simultaneously.) One way to prevent this is to use the GetObject function. When using the GetObject function, specify the Excel.Application class rather than the filename as shown here:
- Set objExcelApp = GetObject(, "Excel.Application")
If Microsoft Excel isn't open, the preceding code returns error #2713. The CreatePIVOTTable function then traps this error and launches a new copy of Microsoft Excel using the CreateObject function.
The CreatePIVOTTable function uses OLE automation to save Microsoft Excel's existing screen position and then reposition Microsoft Excel to display the pivot table on top of the Access window.
The CreatePIVOTTable function creates a new Microsoft Excel workbook with a sheet named "Inventory."
The CreatePIVOTTable function opens Pivot.XLA (a Microsoft Excel add-in), which actually creates the pivot table. (See the next section, titled Pivot.XLA, for more information about this.) It uses the following code to open the add-in, run the add-in's MakePivotTable subroutine, and then close the add-in:

objExcelApp.Workbooks.Open strAddInPath
objExcelApp.Run "MakePivotTable"
objExcelApp.Workbooks("PIVOT.XLA").[Close] False

Function CreatePIVOTTable ()
    On Error GoTo PIVOTError

'Return value of IsCurDBExclusive function.
    Dim intIsExclusive As Integer

'Message for message box.
    Dim msg As String

'Is PIVOT.MDB open for shared access?
'Call IsCurDBExclusive function to find out...
    intIsExclusive = IsCurDBExclusive()
    Select Case intIsExclusive
    Case 0

'Do nothing.
    Case -1
        msg = "This database is open for exclusive access. To "
        msg = msg & "create a pivot table, close the database, "
        msg = msg & "then re-open it for shared access."
        MsgBox msg, 48, "PIVOT"
        Exit Function
    Case Else
        Error intIsExclusive
    End Select

'Note that this function uses Microsoft Excel intrinsic constants
'(declared globally) to manage window state. You must
'declare all such constants to use them via OLE automation.

'Object variable for PIVOT.MDB.
    Dim DB As Database

'Full path for PIVOT.MDB.
    Dim strAppPath As String

'Full path for PIVOT.XLA.
    Dim strAddInPath As String

'Microsoft Excel worksheet containing pivot table.
    Dim objPIVOTSheet As Object

'Status indicator form and label control.
    Dim frmInvStatus As Form, lblWhatGoesOn As Control

'Path for PIVOT.XLA.
    Dim strAddInName As String

'Get the full path for PIVOT.MDB.
    Set DB = DBEngine(0)(0)
    strAppPath = DB.Name

'Call sub to verify database path in connection string.
    CheckConnect strAppPath

'Verify that PIVOT.XLA is in same directory as PIVOT.MDB.
'If it isn't, the Dir$ function returns an empty string and
'the application displays a message box with instructions.
    strAddInPath = ExtractPath(strAppPath) & "PIVOT.XLA"
    Do
        strAddInName = Dir$(strAddInPath)
        If strAddInName <> "" Then
            Exit Do
        Else
            If MsgBox("Can't find PIVOT.XLA. To continue, switch 
                to File Manager and move PIVOT.XLA to " & 
                ExtractPath(strAppPath) & ", and then return and  
                click OK. Otherwise, click Cancel.", 49, "PIVOT")  
                = 2 Then
              Exit Function
            End If
        End If
    Loop

'Handles status indicator form.
    DoCmd OpenForm "Inventory Status", A_NORMAL, , , A_READONLY, 
        A_NORMAL
    Set frmInvStatus = Forms("Inventory Status")
    Set lblWhatGoesOn = frmInvStatus!StatusInfo


'Get a Microsoft Excel application object.
    lblWhatGoesOn.Caption = "Opening Microsoft Excel..."
    frmInvStatus.Repaint

'If Microsoft Excel isn't open, this generates error 2713.
    Set objExcelApp = GetObject(, "Excel.Application")
    fCloseExcel = False

ExcelOpened:
'Record Microsoft Excel's display settings. ClosePIVOTTable restores
'these settings. If Microsoft Excel is minimized, it will be restored
'to its state prior to minimization.
    ExcelAppState = objExcelApp.WindowState
    fMinimized = False
    If ExcelAppState = xlMinimized Then
        fMinimized = True
        objExcelApp.WindowState = xlNormal
        ExcelAppState = objExcelApp.WindowState
    End If
    ExcelLeft = objExcelApp.Left
    ExcelTop = objExcelApp.Top
    ExcelWidth = objExcelApp.Width
    ExcelHeight = objExcelApp.Height
    PIVOTToolbarState = objExcelApp.Toolbars("Query and 
        PIVOT").Visible

'Set the size and position of Microsoft Excel's application window.
    objExcelApp.WindowState = xlNormal
    objExcelApp.Left = 46
    objExcelApp.Top = 90
    objExcelApp.Width = 398
    objExcelApp.Height = 203
    objExcelApp.Toolbars("Query and PIVOT").Visible = True

'Create a new workbook.
    lblWhatGoesOn.Caption = "Creating new workbook..."
    frmInvStatus.Repaint
    objExcelApp.ScreenUpdating = False
    objExcelApp.Workbooks.Add
    Set objWorkbook = objExcelApp.ActiveWorkbook

'Add a new worksheet to the workbook.
    lblWhatGoesOn.Caption = "Adding new worksheet..."
    frmInvStatus.Repaint
    Set objPIVOTSheet = objWorkbook.ActiveSheet
    objPIVOTSheet.Name = "Inventory"

'Record current window state, and then maximize it.
    ExcelCurrWindowState = objExcelApp.ActiveWindow.WindowState
    objExcelApp.ActiveWindow.WindowState = xlMaximized

'Open PIVOT.XLA.
    lblWhatGoesOn.Caption = "Opening PIVOT.XLA..."
    frmInvStatus.Repaint
    objExcelApp.Workbooks.Open strAddInPath

'Call the MakePIVOTTable macro in PIVOT.XLA.
    lblWhatGoesOn.Caption = "Creating PIVOT table (this can take a 
        while)..."
    frmInvStatus.Repaint
    objExcelApp.Run "MakePIVOTTable"

'Close PIVOT.XLA.
    objExcelApp.Workbooks("PIVOT.XLA").[Close] False

'Display worksheet with the pivot table.
    lblWhatGoesOn.Caption = "Displaying Microsoft Excel..."
    frmInvStatus.Repaint
    objExcelApp.ScreenUpdating = True
    objExcelApp.Visible = True

'Set the focus to Microsoft Excel.
    hExcel = FindWindow("XLMAIN", ByVal 0&)
    hAccess = SetFocusAPI(hExcel)

PIVOTExit:
'Close the status indicator form.
    DoCmd Close A_FORM, "Inventory Status"
    Exit Function

PIVOTError:
'If Microsoft Excel isn't open when the GetObject function is called,
'this error occurs. Launch Microsoft Excel, then resume execution.
    If Err = 2713 Then
        Set objExcelApp = CreateObject("Excel.Application")
        Err = 0
        fCloseExcel = True
        Resume ExcelOpened

'Notify users, clear object variables, and then exit.
    Else
        Select Case Err

'This error occurs if Microsoft Excel returns an error.
        Case 2763
            MsgBox "Error in Microsoft Excel: " & Error$
        Case Else
            MsgBox Str$(Err) & ": " & Error$
        End Select

        Set objPIVOTSheet = Nothing
        Set objWorkbook = Nothing
        Set objExcelApp = Nothing

        DoCmd Close A_FORM, "Inventory Status"
        Exit Function
    End If
    Resume PIVOTExit
End Function