程序代码：
Private Sub cmdCommand1_Click()
Const xlArea = 1
Const xlBar = 2
Const xlColumn = 3
Const xlLine = 4
Const xlPie = 5
Const xlRadar = -4151
Const xlXYScatter = -4169
Const xlCombination = -4111
Const xl3DArea = -4098
Const xl3DBar = -4099
Const xl3DColumn = -4100
Const xl3DLine = -4101
Const xl3DPie = -4102
Const xl3DSurface = -4103
Const xlDoughnut = -4120
' Excel orientation constants:
Const xlRows = 1
Const xlColumns = 2
Dim objChart As Object 'Object reference to Excel
'Chart
Dim objXL As Object 'Object reference for Excel
Dim objSheet As Object 'Object reference to Excel
'Worksheet
Dim iRow As Integer 'Index variable for the
'current Row
Dim iCol As Integer 'Index variable for the
'current Row
Dim cRows As Integer 'Number of rows
Dim cCols As Integer 'Number of Columns
Dim cwSource As String 'Named Range
Static cwGallery(15) As Integer 'Array for Chart types
Static iGallery As Integer 'Index for Chart type array
Dim cwFormat As Integer 'Format of Chart type
Dim cwPlotBy As Integer 'How data is taken from
'Worksheet
Dim cwCategoryLabels As Integer 'Rows/Cols with Catagory
'labels
Dim cwSeriesLabels As Integer 'Rows/Cols with Catagory
'Labels
Dim cwHasLegend As Integer 'Display Legend
Dim cwTitle As String 'Chart Title
Dim cwCategoryTitle As String 'Category Title
Dim cwValueTitle As String 'Value Title
Dim cwExtraTitle As String 'Extra Title for some Charts
'disable this button
' Fill in array with possible Chart types:
cwGallery(1) = xlArea
cwGallery(2) = xlBar
cwGallery(3) = xlColumn
cwGallery(4) = xlLine
cwGallery(5) = xlPie
cwGallery(6) = xlRadar
cwGallery(7) = xlXYScatter
cwGallery(8) = xlCombination
cwGallery(9) = xl3DArea
cwGallery(10) = xl3DBar
cwGallery(11) = xl3DColumn
cwGallery(12) = xl3DLine
cwGallery(13) = xl3DPie
cwGallery(14) = xl3DSurface
cwGallery(15) = xlDoughnut
' Embed a new Excel 5.0 Chart into the OLE control:
OLE1.CreateEmbed "", "Excel.Chart.5"
'BEGIN FIX FOR DIFFERING OBJECT MODELS BETWEEN VERSIONS 7 & 8
' Set object references to Chart, Worksheet, and Application
'objects:
'Excel 95's object model is different from Excel 97's
If Left(OLE1.object.Application.Version, 1) = "7" Then
Set objChart = OLE1.object ' Chart1 default chart
Else 'assume all future excel object models are going to bethe same
Set objChart = OLE1.object.ActiveChart 'ole1.object is in Excel 97 the workbook
End If
Set objSheet = objChart.Parent.Worksheets(1) ' Sheet1 default data
Set objXL = objChart.Application
'END FIX
'Set the number of columns and rows used for data:
cCols = 10
cRows = 3
' Create Series Labels on Worksheet:
For iRow = 1 To cRows
objSheet.Cells(iRow + 1, 1).Value = "SL" & iRow
Next
' Create Category Labels on Worksheet:
For iCol = 1 To cCols
objSheet.Cells(1, iCol + 1).Value = "CL" & iCol
Next
'exiting here leaves the default chart drawn with sample data
' Create random data on Worksheet:
Randomize Timer
For iRow = 1 To cRows
For iCol = 1 To cCols
objSheet.Cells(iRow + 1, iCol + 1).Value = Int(Rnd * 50) + 1
Next iCol
Next iRow
' Name the Range containing the previously added data:
objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(cRows + 1, cCols + 1)).Name = "ChartDataRange"
'objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(cRows + _
1, cCols + 1)).Clear
' Set the ChartWizard parameters:
cwSource = "ChartDataRange" 'Name of Named Range
iGallery = 9 'iGallery Mod 15 + 1 'Iterate through 15 Chart
'types
cwFormat = 1 'Use default format of Chart
'Type
cwPlotBy = xlRows 'Rows = Series orientation
cwCategoryLabels = 1 '1 Row contains Category
'Labels
cwSeriesLabels = 1 '1 Column contains Series
'Labels
cwHasLegend = 1 'Display the Legend
cwTitle = "Embedded Chart" 'Chart Title
cwCategoryTitle = "Categories" 'Category Title
cwValueTitle = "Values" 'Value Title
cwExtraTitle = "Extras" 'Extra Title
' Use the ChartWizard method to fill in the Chart:
objChart.ChartWizard cwSource, cwGallery(iGallery), cwFormat, cwPlotBy, cwCategoryLabels, cwSeriesLabels, cwHasLegend, cwTitle, cwCategoryTitle, cwValueTitle, cwExtraTitle
' Shut Down Excel and erase objects:
Set objXL = Nothing
Set objChart = Nothing
Set objSheet = Nothing
End Sub
说明文件:
http://read.
2017-01-09 19:10
