This article was previously published under Q202169
Advanced: Requires expert coding, interoperability, and multiuser skills.
Notice: This website is an unofficial Microsoft Knowledge Base (hereinafter KB) archive and is intended to provide a reliable access to deleted content from Microsoft KB. All KB articles are owned by Microsoft Corporation. Read full disclaimer for more details.
View products that this article applies to.
Query: qrySalesByCountry ------------------------------------------------------------------ Type: Select Query Join: [Orders].[OrderID] <-> [Order Details Extended].[OrderID] Field: ShipCountry Table: Orders Total: Group By Field: ExtendedPrice Query: Order Details Extended Total: Sum
Option Explicit
Function CreateChart(strSourceName As String, _
strFileName As String)
Dim xlApp As Excel.Application
Dim xlWrkbk As Excel.Workbook
Dim xlChartObj As Excel.Chart
Dim xlSourceRange As Excel.Range
Dim xlColPoint As Excel.Point
On Error GoTo Err_CreateChart
' Create an Excel workbook file based on the
' object specified in the second argument.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, _
strSourceName, strFileName, False
' Create a Microsoft Excel object.
Set xlApp = CreateObject("Excel.Application")
' Open the spreadsheet to which you exported the data.
Set xlWrkbk = xlApp.Workbooks.Open(strFileName)
' Determine the size of the range and store it.
Set xlSourceRange = _
xlWrkbk.Worksheets(1).Range("a1").CurrentRegion
' Create a new chart.
Set xlChartObj = xlApp.Charts.Add
' Format the chart.
With xlChartObj
' Specify chart type as 3D.
.ChartType = xl3DColumn
' Set the range of the chart.
.SetSourceData Source:=xlSourceRange, _
PlotBy:=xlColumns
' Specify that the chart is located on a new sheet.
.Location Where:=xlLocationAsNewSheet
' Create and set the title; set title font.
.HasTitle = True
With .ChartTitle
.Characters.Text = _
"Total Sales by Country"
.Font.Size = 18
End With
' Rotate the x-axis labels to a 45-degree angle.
.Axes(xlCategory).TickLabels.Orientation = 45
' Delete the label at the far right of the x-axis.
.Axes(xlSeries).Delete
' Delete the legend.
.HasLegend = False
' Set each datapoint to show the dollar amount
' and format the datapoint to be currency
' with no decimals.
With .SeriesCollection(1)
.ApplyDataLabels Type:=xlDataLabelsShowValue
.DataLabels.NumberFormat = "$#,##0"
End With
End With
' Position the points further from the tops
' of the columns.
For Each xlColPoint In _
xlChartObj.SeriesCollection(1).Points
xlColPoint.DataLabel.Top = _
xlColPoint.DataLabel.Top - 11
Next xlColPoint
' Save and close the workbook
' and quit Microsoft Excel.
With xlWrkbk
.Save
.Close
End With
xlApp.Quit
Exit_CreateChart:
Set xlSourceRange = Nothing
Set xlColPoint = Nothing
Set xlChartObj = Nothing
Set xlWrkbk = Nothing
Set xlApp = Nothing
Exit Function
Err_CreateChart:
MsgBox CStr(Err) & " " & Err.Description
Resume Exit_CreateChart
End Function
?CreateChart("qrySalesByCountry","c:\Sales.xls")
Keywords: KB202169, kbprogramming, kbhowto