Class: Excel in Category Microsoft Excel : Automation from Total Visual SourceBook

' Example of CExcel
'
' To use this example, create a new module and paste this code into it.
' There are several procedures available by calling Examples_CExcel.
' You can watch as several Excel spreadsheets are created.
' Put the cursor in the procedure and press:
'    F5 to run it, or
'    F8 to step through it line-by-line (see the Debug menu for more options)

Private Const mcstrSamplePath As String = "C:\Total Visual SourceBook 2013\Samples\"
Private Const mcstrSampleDB As String = mcstrSamplePath & "SAMPLE.MDB"
Private Const mcstrTempInsert As String = mcstrSamplePath & "ExcelSample1.XLSX"
Private Const mcstrTempImport As String = mcstrSamplePath & "ExcelSample2.XLSX"

' Change to False to use an existing instance of Excel, if it's open
Private Const mcfNewInstance As Boolean = True

Private Sub Examples_CExcel()
  ' Comments: Example of using the CExcel class to automate Microsoft Excel from VBA and VB6.

  Dim strMsg As String
  Dim clsExcel As CExcel
  Dim fContinue As Boolean

  ' Instantiate the class
  Set clsExcel = New CExcel

  ' Before continuing, we want to be sure that the computer doesn't have an existing instance of Excel running.
  ' This is so our example code doesn't erroneously interact with the wrong instance of Excel and cause problems.
  If clsExcel.IsOpen() Then
    strMsg = "Excel is currently open. To avoid modifying your spreadsheets, close Excel before continuing." & vbCrLf & vbCrLf & "Do you want to continue?"
    fContinue = (MsgBox(strMsg, vbYesNo + vbCritical) = vbYes)
  Else
    ' Excel isn't open, so no need to prompt the user
    fContinue = True
  End If

  Set clsExcel = Nothing

  If fContinue Then
    ' Clean up any temp files from a previous run of this example
    On Error Resume Next
    Kill mcstrTempImport
    Kill mcstrTempInsert
    On Error GoTo 0

    ' Example of getting and setting basic information for an Excel spreadsheet (workbook) and worksheets such as margins, header, footer, document information; and printing
    ExampleExcel_BasicInfo

    ' Example of creating an Excel spreadsheet (mcstrTempInsert), inserting data and formulas, adding and deleting rows and columns using ranges
    ExampleExcel_InsertDataAndFormulas

    ' Create a new spreadsheet (mcstrTempImport), import data from an Access database into it using two techniques, create and select ranges, set cell properties for font, color and number formats.
    ExampleExcel_ImportAndFormatData

    ' Create a new spreadsheet, import data and create two pivot tables from it.
    ExampleExcel_PivotTable
  End If

End Sub

Private Sub ExampleExcel_BasicInfo()
  ' Comments: Example of getting and setting basic information for an Excel spreadsheet (workbook) and worksheets such as margins, header, footer, document information; and printing
  '           This workbook is never saved but is left open in Excel if you choose.
  '           See the Immediate Window for additional information.

  Const cstrSheetName1 As String = "SourceBook Example"
  Const cstrSheetName2 As String = "New Worksheet"

  Dim clsExcel As CExcel
  Dim strError As String
  Dim intWorksheets As Integer
  Dim astrWorksheets() As String
  Dim intCounter As Integer
  Dim fSetActive As Boolean
  Dim colSheets As Collection

  Set clsExcel = New CExcel

  ' Start the instance of Excel and make it visible (or use the existing instance if it's already open)
  Set clsExcel = New CExcel
  If clsExcel.StartExcel(mcfNewInstance) Then
    strError = clsExcel.CreateWorkbook()
    If strError = "" Then
      ' Get the list of worksheets in the workbook (depends on the default number of worksheets for a new spreadsheet)
      intWorksheets = clsExcel.WorksheetNames(astrWorksheets())
      Debug.Print intWorksheets & " worksheets"
      For intCounter = 1 To intWorksheets
        Debug.Print "Worksheet " & intCounter & ": " & astrWorksheets(intCounter)
      Next intCounter

      ' Delete Worksheet "Sheet3"
      strError = clsExcel.DeleteWorksheet("Sheet3")
      If strError = "" Then
        Debug.Print "Sheet3 deleted"

        ' Set a worksheet as active
        fSetActive = clsExcel.SetActiveWorksheet("Sheet1")
        Debug.Print "Sheet1 " & IIf(fSetActive, "is", "is not") & " active"

        ' Replace the default Excel caption with your own
        clsExcel.ExcelCaption = "Custom Excel Caption"
        Debug.Print "The Excel caption is: " & clsExcel.ExcelCaption

        ' Replace the default Workbook showing the Excel name with your own
        clsExcel.WorkbookCaption = "Your Workbook Caption"
        Debug.Print "The Excel Workbook caption is: " & clsExcel.WorkbookCaption

        ' Rename the worksheet to another name
        clsExcel.WorksheetName = cstrSheetName1

        ' Put a value in the first cell
        Call clsExcel.SetCellValue_ByRowColumn(1, 1, "Worksheet " & cstrSheetName1 & " created " & Now)

        ' Create a new worksheet AFTER the existing one
        clsExcel.CreateWorksheet cstrSheetName2, False

        ' Put a value in the first cell
        Call clsExcel.SetCellValue_ByRowColumn(1, 1, "Worksheet: " & cstrSheetName2 & " created " & Now)

        ' Change the Margins/Footers/Headers (in inches)
        clsExcel.TopMargin = ".75"
        clsExcel.BottomMargin = ".75"
        clsExcel.LeftMargin = ".25"
        clsExcel.RightMargin = ".25"
        clsExcel.LeftHeader = "My Left Header"
        clsExcel.RightHeader = "My Right Header"
        clsExcel.LeftFooter = "My Left Footer"
        clsExcel.RightFooter = "My Right Footer"

        ' Retrieve the margin, header, and footer information
        Debug.Print
        Debug.Print "Current Margins/Footers/Headers after the change"
        Debug.Print "---------------------------------------"
        Debug.Print "Top Margin   : " & clsExcel.TopMargin
        Debug.Print "Bottom Margin: " & clsExcel.BottomMargin
        Debug.Print "Left Margin  : " & clsExcel.LeftMargin
        Debug.Print "Right Margin : " & clsExcel.RightMargin
        Debug.Print "Left Footer  : " & clsExcel.LeftFooter
        Debug.Print "Right Footer : " & clsExcel.RightFooter
        Debug.Print "Left Header  : " & clsExcel.LeftHeader
        Debug.Print "Right Header : " & clsExcel.RightHeader
        Debug.Print

        ' Page Orientation
        Select Case clsExcel.PageOrientation
          Case Excel.XlPageOrientation.xlLandscape
            Debug.Print "The current page orientation is: Landscape"
          Case Excel.XlPageOrientation.xlPortrait
            Debug.Print "The current page orientation is: Portrait"
        End Select

        ' Set the document properties
        Debug.Print "DocumentProperties: Setting Document Properties "
        clsExcel.DocumentProperties(xldpAuthor) = Environ("UserName")
        clsExcel.DocumentProperties(xldpCategory) = "Examples"
        clsExcel.DocumentProperties(xldpComments) = "Created " & Now
        clsExcel.DocumentProperties(xldpCompany) = "My Organization"
        clsExcel.DocumentProperties(xldpKeywords) = "Excel, sample, Total Visual SourceBook, CExcel"
        clsExcel.DocumentProperties(xldpManager) = "My Boss"
        clsExcel.DocumentProperties(xldpSubject) = "Total Visual SourceBook Sample"
        clsExcel.DocumentProperties(xldpTitle) = "Automation Example"

        ' Retrieve the document properties (appears on the spreadsheet's File, Info page)
        Debug.Print "DocumentProperties: Getting Document Properties "
        Debug.Print clsExcel.DocumentProperties(xldpAuthor)
        Debug.Print clsExcel.DocumentProperties(xldpCategory)
        Debug.Print clsExcel.DocumentProperties(xldpComments)
        Debug.Print clsExcel.DocumentProperties(xldpCompany)
        Debug.Print clsExcel.DocumentProperties(xldpKeywords)
        Debug.Print clsExcel.DocumentProperties(xldpManager)
        Debug.Print clsExcel.DocumentProperties(xldpSubject)
        Debug.Print clsExcel.DocumentProperties(xldpTitle)

        ' Print a range of sheets
        If MsgBox("Do you want to print the workbook?", vbQuestion + vbYesNo) = vbYes Then
          ' To do this, we must populate a collection with the sheet names we want to print. First, we'll create three new sheets
          Set colSheets = New Collection
          Call colSheets.Add(cstrSheetName1)
          Call colSheets.Add(cstrSheetName2)

          ' Print the sheets as a single batch
          clsExcel.PrintSelectedSheets colSheets, 1, False, True

          ' Uncomment this to print the current worksheet
          ' clsExcel.PrintActiveWorksheet 1, 1, 1, False, False, False

          ' Uncomment this line to print the sheets as individual jobs
          'clsExcel.PrintSelectedSheets colSheets, 1, False, False
        End If

        If MsgBox("Do you want discard the workbook and close Excel?", vbQuestion + vbYesNo) = vbYes Then
          ' Close and don't save the current document
          clsExcel.CloseWorkbook False
          clsExcel.CloseExcel
        End If

      Else
        MsgBox "Could not delete Sheet3: " & strError
      End If
    Else
      MsgBox "Workbook could not be created: " & strError
    End If
  Else
    MsgBox "Excel could not be started"
  End If

  Set clsExcel = Nothing
End Sub

Private Sub ExampleExcel_InsertDataAndFormulas()
  ' Comments: Example of creating an Excel spreadsheet (mcstrTempInsert), inserting data and formulas, adding and deleting rows and columns using ranges
  '           Creates a file named by the mcstrTempInsert1 constant.
  '           See the Immediate Window for additional information.

  Const cstrRangeName As String = "MyData"
  Dim clsExcel As CExcel
  Dim strError As String
  Dim intCounter As Integer

  ' Start the instance of Excel and make it visible (or use the existing instance if it's already open)
  Set clsExcel = New CExcel
  If clsExcel.StartExcel(mcfNewInstance) Then
    strError = clsExcel.CreateWorkbook()
    If strError = "" Then
      Debug.Print
      Debug.Print "CreateWorkbook(): new workbook created."

      ' ----------------------
      ' Show the properties of the cell befor they are set
      ExampleExcel_CellProperties clsExcel, "Title Cell Properties Before", "", 1, 1

      ' Insert and format title, font, colors, and underline
      clsExcel.SetCellValue_ByRowColumn 1, 1, "New Worksheet Title"
      clsExcel.SetCellFontDetails "A1", "Tahmoa", 12, True, True, vbRed, vbYellow
      clsExcel.SetCellFontUnderline_ByRowColumn 1, 1, ulSingle

      ' Example of autofitting the width of one column (the first column)
      clsExcel.SetColumnWidth 1

      ' Show the properties of the cell after they are set
      ExampleExcel_CellProperties clsExcel, "Title Cell Properties After", "", 1, 1
      ' ----------------------

      ' Insert some values in three columns (B thru D)
      For intCounter = 2 To 10
        clsExcel.SetCellValue_ByRange "B" & intCounter, intCounter
        ' Enter a random number between 0 and 50
        clsExcel.SetCellValue_ByRange "C" & intCounter, Int(Rnd() * 50)
        ' Enter a random number between 0 and 50
        clsExcel.SetCellValue_ByRange "D" & intCounter, Int(Rnd() * 50)
      Next intCounter

      ' Set the formula for a range of cells in four columns
      clsExcel.SetCellFormula_ByRange "G2:I10", "=B2+C2+D2"

      ' Create a name for a range of cells
      Call clsExcel.CreateRange(cstrRangeName, "G2", "J10")

      ' Select a different range of cells (if paused after this, you'll see these cells highlighted)
      Call clsExcel.SelectRange("G3", "J5")

      ' Color the cells (background) of the defined range name; notice this can be set without changing the selected range of cells
      Call clsExcel.SetCellColor_ByRange(cstrRangeName, vbGreen)

      ' Select a range of cells by name
      Call clsExcel.SelectRange_ByRange(cstrRangeName)

      ' Examples of deleting columns:
      ' Delete a range of three columns
      clsExcel.DeleteColumn_ByRange "G1:I1"

      ' Delete a single column
      clsExcel.DeleteColumn_ByColumn 7

      ' Create a summary column to the right of the range of cells summing each row
      clsExcel.CreateSummaryColumn stSum, "B2:D10"
      ' Set the summary column bold
      clsExcel.SetCellFontBold_ByRange "E1:E11", True

      ' Add a label for the total column (by row and column number)
      clsExcel.SetCellValue_ByRowColumn 1, 5, "Total"
      ' Make the cell right aligned
      clsExcel.SetCellAlignmentHorizontal_ByRange "E1", xlRight

      ' Create a summary row immediately below the range of cells summing each column, plus a grand total to the right of it
      clsExcel.CreateSummaryRow stSum, "B2:D10", True

      ' Add a label for the total row and make it right aligned
      clsExcel.SetCellValue_ByRange "A11", "Total"
      clsExcel.SetCellAlignmentHorizontal_ByRange "A11", xlRight

      ' Format the summary row
      clsExcel.SetCellFontDetails "A11:E11", "Tahoma", 12, True, True, vbYellow, vbBlue
      clsExcel.SetCellFontUnderline_ByRange "A12:E12", ulDoubleAccounting

      ' Another way to enter summaries
      ' Set the formula to calculate totals for the relative cells above them (would usually just have one row but an extra one is added as an example to delete next)
      clsExcel.SetCellFormula_ByRange "B13:D14", "=Sum(B2:B10)"
      ' Delete the rows
      clsExcel.DeleteRow_ByRange "B13:B14"

      ' Determine what properties are set
      ExampleExcel_CellProperties clsExcel, "Summary Row Cell Properties", "B11:D11", 1, 1

      ' Sort the rows on the second column in descending order
      clsExcel.SortRange "B2:D10", "C1", False
      Debug.Print "SortRange(): sorted descending on range."

      If MsgBox("Do you want to save the workbook?", vbQuestion + vbYesNo) = vbYes Then
        ' Save the document under another name before adding the formulas
        strError = clsExcel.SaveCurrentDocumentAs(mcstrTempInsert)
        If strError = "" Then
          MsgBox mcstrTempInsert & " successfully created"
        Else
          MsgBox mcstrTempInsert & " could not be created: " & strError
        End If
      End If

      If MsgBox("Do you want close the workbook and Excel?", vbQuestion + vbYesNo) = vbYes Then
        ' Close the workbook
        clsExcel.CloseWorkbook False
        clsExcel.CloseExcel
      End If
    Else
      MsgBox "New workbook could not be created: " & strError
    End If
  Else
    MsgBox "Excel could not be started"
  End If

  Set clsExcel = Nothing
End Sub

Private Sub ExampleExcel_CellProperties(clsExcel As CExcel, strDescription As String, ByVal strRange As String, ByVal intRow As Integer, ByVal intColumn As Integer)
  ' Comments: Get the cell properties
  ' Params  : clsExcel        Excel class already initilaized to the desired worksheet
  '           strDescription  Description to show
  '           strRange        Range of cells to show, if blank, use the row and position
  '           intRow          Row of first cell
  '           intColumn       Column of first cell

  Const cstrTrueFalse As String = "True/False"

  Debug.Print
  Debug.Print strDescription
  Debug.Print "-----------------------------"

  If strRange = "" Then
    Debug.Print "Address   : " & clsExcel.GetCellAddress(intRow, intColumn, True, True, True)
    Debug.Print "Font      : " & clsExcel.GetCellFontName_ByRowColumn(intRow, intColumn)
    Debug.Print "Size      : " & clsExcel.GetCellFontSize_ByRowColumn(intRow, intColumn)
    Debug.Print "Bold      : " & Format(clsExcel.GetCellFontBold_ByRowColumn(intRow, intColumn), cstrTrueFalse)
    Debug.Print "Italic    : " & Format(clsExcel.GetCellFontItalic_ByRowColumn(intRow, intColumn), cstrTrueFalse)
    Debug.Print "Underline : " & clsExcel.GetCellFontUnderline_ByRowColumn(intRow, intColumn)
    Debug.Print "Text Color: " & clsExcel.GetCellFontColor_ByRowColumn(intRow, intColumn)
    Debug.Print "Cell Color: " & clsExcel.GetCellColor_ByRowColumn(intRow, intColumn)
    Debug.Print "Formula   : " & clsExcel.GetCellFormula_ByRowColumn(intRow, intColumn)
    Debug.Print "Value     : " & clsExcel.GetCellValue_ByRowColumn(intRow, intColumn)
  Else
    Debug.Print "Address   : " & strRange
    Debug.Print "Font      : " & clsExcel.GetCellFontName_ByRange(strRange)
    Debug.Print "Size      : " & clsExcel.GetCellFontSize_ByRange(strRange)
    Debug.Print "Bold      : " & Format(clsExcel.GetCellFontBold_ByRange(strRange), cstrTrueFalse)
    Debug.Print "Italic    : " & Format(clsExcel.GetCellFontItalic_ByRange(strRange), cstrTrueFalse)
    Debug.Print "Underline : " & clsExcel.GetCellFontUnderline_ByRange(strRange)
    Debug.Print "Text Color: " & clsExcel.GetCellFontItalic_ByRange(strRange)
    Debug.Print "Cell Color: " & clsExcel.GetCellFontBold_ByRange(strRange)
    Debug.Print "Formula   : " & clsExcel.GetCellFormula_ByRange(strRange)
    Debug.Print "Value     : " & clsExcel.GetCellValue_ByRange(strRange)
  End If
  Debug.Print

End Sub

Private Sub ExampleExcel_ImportAndFormatData()
  ' Comments: Example of creating an Excel spreadsheet and importing data into it from an Access database, creating and selecting ranges, setting cell properties for font, color and number formats.
  '           Two examples are shown, one using the CreateTableFromAccessFast function and the other with the more flexible but slower CreateTableFromAccess function.
  '           Creates a file named by the mcstrTempImport constant.
  '           See the Immediate Window for additional information as data is processed for range values.

  Const cstrSampleTable As String = "Orders"
  Const cstrCellStart As String = "B3"
  Const cintMaxRecords As Integer = 50
  Const cintMaxFields As Integer = 10
  Const cstrRangeName As String = "ImportedData"
  Const cstrRangeAccess As String = "ImportedAccess"

  Dim clsExcel As CExcel
  Dim strRangeCells As String
  Dim strRangeFirstRow As String
  Dim strRangeFirstCol As String

  Set clsExcel = New CExcel

  ' Start the instance of Excel and make it visible (or use the existing instance if it's already open)
  If clsExcel.StartExcel(mcfNewInstance) Then
    ' Create the new file
    clsExcel.CreateWorkbook mcstrTempImport
    Debug.Print
    Debug.Print "CreateWorkbook(): new workbook " & mcstrTempImport & " created."

    ' Set the worksheet name to this example
    clsExcel.WorksheetName = "CreateTableFromAccessFast"

    ' Import a table from Microsoft Access and insert into the spreadsheet
    ' Include the field names and place it starting with the 3rd row, 2nd column.
    ' Retrieve the first 50 records and give the data a range name specified by cstrRangeName.

    ' Get a table from Microsoft Access and insert the first 50 records and 10 fields into the sheet using the CopyRecordset method
    clsExcel.CreateTableFromAccessFast mcstrSampleDB, cstrSampleTable, True, cstrCellStart, cstrRangeName, cintMaxRecords, cintMaxFields
    Debug.Print "CreateTableFromAccessFast(): imported Access table into Excel."

    ' Different ways to get the cells for a range name
    strRangeCells = clsExcel.GetRangeAddress(cstrRangeName)
    Debug.Print "Range of cells (absolute, A1)  : " & strRangeCells

    strRangeCells = clsExcel.GetRangeAddress(cstrRangeName, False, False)
    Debug.Print "Range of cells (relative, A1)  : " & strRangeCells

    strRangeCells = clsExcel.GetRangeAddress(cstrRangeName, False, False, False)
    Debug.Print "Range of cells (relative, R1C1): " & strRangeCells

    strRangeCells = clsExcel.GetRangeAddress(cstrRangeName, , , False)
    Debug.Print "Range of cells (absolute, R1C1): " & strRangeCells

    ' ------------------
    ' Get cells for portions of the range

    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 1, 1)
    Debug.Print "First cell of Range : " & strRangeCells

    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, -1, -1)
    Debug.Print "Last cell of Range  : " & strRangeCells

    strRangeFirstCol = clsExcel.GetRangeSubAddress(cstrRangeName, 0, 1)
    Debug.Print "Cells for First Col : " & strRangeFirstCol

    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 0, -1)
    Debug.Print "Cells for Last Col  : " & strRangeCells

    strRangeFirstRow = clsExcel.GetRangeSubAddress(cstrRangeName, 1, 0)
    Debug.Print "Cells for First Row : " & strRangeFirstRow

    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, -1, 0)
    Debug.Print "Cells for Last Row  : " & strRangeCells

    ' ------------------
    ' Format the cells: fonts, color, number format

    ' Format the entire range. Set the font and color for the field names
    clsExcel.SetCellFontDetails cstrRangeName, "Segoe UI", 10, False, False, vbBlack, vbCyan

    ' Format the first row. Set the font and color for the field names
    strRangeFirstRow = clsExcel.GetRangeSubAddress(cstrRangeName, 1, 0)
    clsExcel.SetCellFontDetails strRangeFirstRow, "Tahoma", 11, True, True, vbYellow, vbBlue

    ' Center the 3rd column
    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 0, 3)
    Call clsExcel.SetCellAlignmentHorizontal_ByRange(strRangeCells, xlCenter)

    ' Set 8th column to Currency numeric format
    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 0, 8)
    Call clsExcel.SetCellNumberFormat_ByRange(strRangeCells, "$#,##0.00")

    ' Set 4th column to a date format
    strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 0, 4)
    Call clsExcel.SetCellNumberFormat_ByRange(strRangeCells, "mm/dd/yy")

    ' ------------------
    ' Horizontally center the field names and first column
    Call clsExcel.SetCellAlignmentHorizontal_ByRange(strRangeFirstRow, xlCenter)
    Call clsExcel.SetCellAlignmentHorizontal_ByRange(strRangeFirstCol, xlCenter)

    ' ------------------
    ' Adjust the width of a column so it shows the entire value (autofit); this should be done after the cell formatting which may impact the width.

    ' Example of autofitting the width of one column: 10th column
    clsExcel.SetColumnWidth 10

    ' Autofit the column width of all the columns in the range
    clsExcel.SetColumnWidth_ByRange cstrRangeName

    ' ------------------
    If MsgBox("Do you want to perform spell checking?", vbQuestion + vbYesNo) = vbYes Then
      ' Spell checking the data in all the rows of the 9th column of the range
      strRangeCells = clsExcel.GetRangeSubAddress(cstrRangeName, 0, 9)
      clsExcel.SpellCheckRange strRangeCells
    End If

    ' ------------------
    ' Create a new worksheet
    If MsgBox("Do you want to create a new worksheet and import the table using slower, more flexible method?", vbQuestion + vbYesNo) = vbYes Then
      ' Create the new worksheet after the current one
      clsExcel.CreateWorksheet "CreateTableFromAccess", False

      ' Retrieve data from a table record by record with the opportunity to adjust data as it's processed. This is more flexible but slower than CreateTableFromAccessFast
      ' This brings in all the fields.
      clsExcel.CreateTableFromAccess mcstrSampleDB, cstrSampleTable, True, cstrCellStart, cstrRangeAccess, cintMaxRecords
      Debug.Print "CreateTableFromAccess(): imported Access table into Excel."

      ' Autofit the column width of all the columns
      clsExcel.SetColumnWidth_ByRange cstrRangeAccess
    End If

    If MsgBox("Do you want to discard the spreadsheet and close Excel?", vbQuestion + vbYesNo) = vbYes Then
      ' Close and save the workbook
      clsExcel.CloseWorkbook False
      clsExcel.CloseExcel
    End If
  Else
    MsgBox "Excel could not be started"
  End If

  Set clsExcel = Nothing

End Sub

Private Sub ExampleExcel_PivotTable()
  ' Comments: Example of creating an Excel spreadsheet with two Pivot Tables using data imported from an Access database.
  '           The first worksheet has a pivot table of the quantity by Country (row) and Product (column).
  '           The second worksheet has a pivot table of sales by two row fields (Country and Company) and Product (column).

  Const cstrDestCell As String = "J2"
  Const cstrQuery As String = "qryOrderProducts"
  Const cstrDataRange As String = "DataRange"

  Dim clsExcel As CExcel
  Dim strError As String

  Set clsExcel = New CExcel

  ' Start the instance of Excel and make it visible
  If clsExcel.StartExcel(mcfNewInstance) Then

    ' Create a new workbook
    clsExcel.CreateWorkbook

    clsExcel.WorksheetName = "Country Quantity"

    ' Get a table from Microsoft Access and insert the first 50 records and 10 fields into the sheet using the CopyRecordset method.
    ' Assign the new data range to cstrDataRange
    clsExcel.CreateTableFromAccessFast mcstrSampleDB, cstrQuery, True, "A1", cstrDataRange

    ' Create a Pivot Table on Current Sheet
    clsExcel.CreatePivotTable cstrDataRange, cstrDestCell, "Country", "ProductName", "Quantity", xlSum

    ' Create a second pivot table on another sheet with two row fields
    clsExcel.CreateWorksheet "Country Company Sales", False
    clsExcel.CreatePivotTable cstrDataRange, "A1", "Country;CompanyName", "ProductName", "Sales", xlSum, "$ #,##0"

    If MsgBox("Do you want to close the spreadsheet and Excel?", vbQuestion + vbYesNo) = vbYes Then
      ' Close and do not save the workbook
      clsExcel.CloseWorkbook False
      clsExcel.CloseExcel
    End If
  Else
    MsgBox "Excel could not be started"
  End If

  Set clsExcel = Nothing
End Sub

The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!

Additional Resources

• List of All Modules in Total Visual SourceBook
• List of All Code Categories in Total Visual SourceBook
• Sample Module Code from Total Visual SourceBook (Example of Date, Time and Age Calculations)