********************************************************************************************
Excel chart creation thru automation
********************************************************************************************
Private Sub cmdCreateSpreadsheet_Click()
Dim varArray as Variant
Dim recSales As Recordset ' Recorset to create chart from
Dim objExcel As New Excel.Application ' Excel object
DoCmd.Hourglass True ' Turn on the Hourglass -- to encourage wait by User
Set recSales = CurrentDb().OpenRecordset("qryMonthlySales") ' Creating recordset from QueryDef
recSales.MoveLast ' Move to the last record to update record count
recSales.MoveFirst ' Move to the first record
varArray = recSales.GetRows(recSales.RecordCount) ' Load the array with the query results
recSales.Close ' Close the recordset
objExcel.Workbooks.Add ' Add a new Excel workbook
' ****************************************************************************
For intFld = 0 To UBound(varArray, 1) ' Pass the values from the array into the Excel sheet
For intRow = 0 To UBound(varArray, 2)
objExcel.Cells(intRow + 2, intFld + 1).Value = varArray(intFld, intRow)
Next
Next
' *****************************************************************************
' Work on the data as desired using regular Excel commands -- simply recede them with
' objExcel as with objExcel.Range("A1:C3").Select
' *****************************************************************************
' As with modifying a Chart -- see this:
Set objChart = objExcel.ActiveChart
With objChart
.ChartType = xl3DArea
.HasTitle = True ' Add some titles
.ChartTitle.Text = "Monthly Sales"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Caption = "Month"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Caption = "Sales"
.Axes(xlSeriesAxis).HasTitle = True
.Axes(xlSeriesAxis).AxisTitle.Caption = "Year"
.HasLegend = False
End With
objExcel.ActiveWorkbook.Close True, "C:\BegVBA\MnthSale.XLS" ' Saving & closing Workbook
' Close Excel and free the memory
Set objChart = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
objExcel.Quit ' Leave the Excel application
Exit Sub
*** or a more complext example of inserting data and creating a chart therefrom ******
Public Sub CreateChart()
'
' Purpose: To create an Excel chart from a recordset
'
Dim recSales As Recordset ' Recorset to create chart from
Dim varArray As Variant ' Array of entries from above
Dim objExcel As New Excel.Application ' Excel object
Dim objChart As Object ' Excel chart object
Dim intFields As Integer ' Number of fields in recordset
Dim intRows As Integer ' Number of rows in recordset
Dim intFld As Integer ' Loop index for fields
Dim intRow As Integer ' Loop index for rows
Dim strRange As String ' Range of Excel cells for data
On Error GoTo CreateChart_Err
' Turn on the hourglass before opening the recordset
DoCmd.Hourglass True
Set recSales = CurrentDb().OpenRecordset("qryxMonthlySales")
' Move to the last record so we get an accurate record count
recSales.MoveLast
' Copy the whole recordset into an array, and close the recordset
recSales.MoveFirst
varArray = recSales.GetRows(recSales.RecordCount)
' Determine the number of rows and fields in the array
intFields = UBound(varArray, 1)
intRows = UBound(varArray, 2)
' create a new workbook
objExcel.Workbooks.Add
' fill the years and close the recordset
recSales.MoveFirst
For intFld = 1 To intFields
objExcel.Cells(intRow + 1, intFld + 1).Value = recSales.Fields(intFld).Name
Next
recSales.Close
' Pass the values from the array into the Excel sheet
For intFld = 0 To intFields
For intRow = 0 To intRows
objExcel.Cells(intRow + 2, intFld + 1).Value = varArray(intFld, intRow)
Next
Next
' Determine the A1:C2-type reference for the range containing our data
strRange = "A1:" & Chr$(Asc("A") + intFields) & Format$(intRows + 2)
' Select the range in the Excel sheet and make it active
objExcel.Range(strRange).Select
objExcel.Range(Mid(strRange, 4)).Activate
' Insert a chart based on the active selection
objExcel.Application.Charts.Add
' Add some titles
Set objChart = objExcel.ActiveChart
With objChart
.ChartType = xl3DArea
.HasTitle = True
.ChartTitle.Text = "Monthly Sales"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Caption = "Month"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Caption = "Sales"
.Axes(xlSeriesAxis).HasTitle = True
.Axes(xlSeriesAxis).AxisTitle.Caption = "Year"
.HasLegend = False
End With
objExcel.ActiveWorkbook.Close True, "C:\BegVBA\MnthSale.XLS"
' Close Excel and free the memory
Set objChart = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
CreateChart_Exit:
Exit Sub
CreateChart_Err:
' Tidy up - ensure all objects are cleared
Set objChart = Nothing
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
DoCmd.Hourglass False
MsgBox Err.Number & " - " & Err.Description
Resume CreateChart_Exit
End Sub
|