VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XLPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "OWC Helper Excel Print Object"
Option Explicit

'-- PrintPivotInXL
'
'   Copies the contents of an OWC PivotTable to Excel and
'   then either prints it directly, or leaves the user
'   in print preview mode, allowing the user to customize
'   the print out and then print from within Excel.
'
Public Sub PrintPivotInXL(ptable As Object, fPreview As Boolean, fLandscape As Boolean)
    Dim xlApp As Object           'Ref to Excel application
    Dim wkbk As Object            'Ref to new workbook
    Dim wksht As Object           'Ref to worksheet
    Dim pgsetup As Object         'Ref to page setup object
    Dim nCols As Long             'Number of physical columns used by row headings
    
    
    On Error GoTo Err_PrintPivot
    
    'First copy the entire contents of the
    'OWC PivotTable to the clipboard. By passing
    'the ActiveView object, you are copying the entire view.
    'Pass ptable.Selection to copy just the current selection
    ptable.Copy ptable.ActiveView
    
    'Create an instance of Excel (should work with
    'Excel 97 or 2000 or maybe even 95)
    On Error Resume Next
    Set xlApp = Nothing
    Set xlApp = CreateObject("Excel.Application")
    On Error GoTo Err_PrintPivot
    
    'If the create worked...
    If Not (xlApp Is Nothing) Then
        'Add a new workbook to the Excel instance
        Set wkbk = xlApp.Workbooks.Add()
        
        'Get a reference to the first worksheet in the new book
        Set wksht = wkbk.Worksheets(1)
        
        'Paste the contents of the clipbard into that sheet
        wksht.Paste wksht.Range("a1")
        
        'Call AutoFit over the used range to make sure
        'everything is visible.
        wksht.UsedRange.Columns.AutoFit
        
        'Get the page setup object
        Set pgsetup = wksht.PageSetup
        
        'Now setup the print page to repeat the
        'row and column headings
        pgsetup.PrintTitleRows = "$1:$" & GetNumHeaderRows(ptable)
        nCols = GetNumHeaderCols(ptable)
        If nCols > 0 Then
            pgsetup.PrintTitleColumns = "$A:$" & Chr(Asc("A") + (nCols - 1))
        End If
        
        'set page orientation
        If fLandscape Then
            pgsetup.Orientation = 2 'xlLandscape
        Else
            pgsetup.Orientation = 1 'xlPortrait
        End If
        
        'Also tell it to print grid lines
        pgsetup.PrintGridlines = True
        
        'Set a default header/footer
        pgsetup.CenterHeader = ptable.ActiveView.TitleBar.Caption
        pgsetup.CenterFooter = "Page &P of &N"
        
        If fPreview Then
            'Set UserControl to True and Visible to True
            'to bring Excel to the foreground and let
            'the user interact with it. Excel will not close
            'when the xlApp variable falls out of scope because
            'of these calls
            xlApp.UserControl = True
            xlApp.Visible = True
        
            'put the current worksheet into print preview
            wksht.PrintPreview
            
        Else
            'just kick off the print
            wksht.PrintOut

            'close down our instance of Excel
            'Note, to let the user interact with
            'Excel instead, see the code in the above block
            xlApp.DisplayAlerts = False
            xlApp.Quit
        End If 'fPreview

        'release all our Excel objects
        Set pgsetup = Nothing
        Set wksht = Nothing
        Set wkbk = Nothing
        Set xlApp = Nothing
    Else
        'Failed to create an instance of Excel
        Dim sMsg
        sMsg = "Unable to create the Excel.Appliation object!"
        sMsg = sMsg & " This could be for one of the following reasons:" & String(2, vbCrLf)
        sMsg = sMsg & vbCrLf & String(4, " ") & "- Excel is not installed on this system."
        sMsg = sMsg & vbCrLf & String(4, " ") & "- Excel is not registered properly."
        
        MsgBox sMsg, vbCritical
    End If 'xlApp is nothing
    
    Exit Sub

Err_PrintPivot:
    MsgBox "Encountered the following error:" & String(2, vbCrLf) & Err.Description, vbCritical, "OWC Helper Library"
    Exit Sub
End Sub 'PrintPivotInXL()

'-- GetNumHeaderRows
'
'   Returns the physical number of grid rows
'   taken up by the column headings/title bar in the pivot table
'
Private Function GetNumHeaderRows(ptable)
    'Get the number of included fields on the column axis
    GetNumHeaderRows = GetNumIncFields(ptable.ActiveView.ColumnAxis)
    
    'Add to that a row for the column axis field headers themselves
    'if there are fields and if the drop zone is visible
    If GetNumHeaderRows = 0 Then
        If ptable.ActiveView.ColumnAxis.Label.Visible Then
            GetNumHeaderRows = GetNumHeaderRows + 1
        End If
    Else
        GetNumHeaderRows = GetNumHeaderRows + 1
    End If
    
    'Add to that a row for the row axis/total headers
    '(note: even if total headings are on the rows, there
    ' will still be a row reserved for the row axis field headings)
    GetNumHeaderRows = GetNumHeaderRows + 1

    'Add to that a row if the title bar is visible
    If ptable.ActiveView.TitleBar.Visible Then GetNumHeaderRows = GetNumHeaderRows + 1
    
    'Add 1 row if no filter fields, and 2 rows if there is at least one
    If ptable.ActiveView.FilterAxis.Fieldsets.Count > 0 Then
        GetNumHeaderRows = GetNumHeaderRows + 2
    Else
        GetNumHeaderRows = GetNumHeaderRows + 1
    End If 'filter fields
End Function 'GetNumHeaderRows()

'-- GetNumHeaderCols
'
'   Returns the physical number of grid columns
'   taken up by the row headings in the pivot table
'
Private Function GetNumHeaderCols(ptable)
    GetNumHeaderCols = GetNumIncFields(ptable.ActiveView.RowAxis)
    
    'If there are zero included fields, still leave room
    'for the drop zone (one column) if it is visible
    If (GetNumHeaderCols = 0) And (ptable.ActiveView.RowAxis.Label.Visible) Then
        GetNumHeaderCols = 1
    End If
End Function 'GetNumHeaderCols()

'-- GetNumIncFields
'
'   Common routine for counting the number of
'   included fields on a result axis in a PivotTable
'
Private Function GetNumIncFields(axis)
    Dim fset
    Dim fld
    Dim ct
    
    ct = 0
    
    For Each fset In axis.Fieldsets
        For Each fld In fset.Fields
            If fld.IsIncluded Then
                ct = ct + 1
            End If
        Next 'fld
    Next 'fset
    
    GetNumIncFields = ct
End Function 'GetNumIncFields()

