VB调用Excel将统计的数据生成各类图形

1、在项目中添加引用:
Microsoft Active Server Pages Ojbect Library、
Microsoft Excel 11.0 Object Library、
COM+ Services Type Library
2、在VB项目中新建一个类:pie

类中代码如下:

Dim xl
Dim m_chartName
Dim m_chartType
Dim m_fileName
Public ErrMsg
Public foundErr
Dim iCount
Private Type m_chartData
label As String
value As Double
End Type
Dim tValue As m_chartData
Dim m_chartData() As m_chartData

Public Property Let ChartType(ChartType)
m_chartType = ChartType
End Property
Public Property Get ChartType()
ChartType = m_chartType
End Property

Public Property Let ChartName(ChartName)
m_chartName = ChartName
End Property
Public Property Get ChartName()
ChartName = m_chartName
End Property
Public Property Let FileName(fname)
m_fileName = fname
End Property
Public Property Get FileName()
FileName = m_fileName
End Property

Public Sub AddValue(label, value)
iCount = iCount + 1
ReDim Preserve m_chartData(iCount)
tValue.label = label
tValue.value = value
m_chartData(iCount) = tValue
End Sub
Public Sub PicStart()
On Error Resume Next
Set xlExcel = New Excel.Application
xlExcel.Visible = True
xlExcel.Workbooks.Add
xlExcel.Workbooks(1).Worksheets("sheet1").Activate
'xlExcel.Workbooks(1).Worksheets("sheet1").Cells("2,1").value = m_chartName
For i = 1 To iCount
xlExcel.Worksheets("sheet1").Cells(1, i + 1).value = m_chartData(i).label
xlExcel.Worksheets("sheet1").Cells(2, i + 1).value = m_chartData(i).value
Next
xlExcel.Charts.Add
xlExcel.ActiveChart.ChartType = m_chartType '' -4102 'xl3DPie
xlExcel.ActiveChart.SetSourceData xlExcel.Sheets("sheet1").Range("a1:" & Chr((iCount Mod 26) + Asc("a")) & "2"), 1
xlExcel.ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
xlExcel.ActiveSheet.Shapes("图表 1").ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
xlExcel.ActiveSheet.Shapes("图表 1").ScaleHeight 1.01, msoFalse, msoScaleFromTopLeft
xlExcel.ActiveSheet.Shapes("图表 1").ScaleWidth 1.01, msoFalse, msoScaleFromBottomRight
xlExcel.ActiveSheet.Shapes("图表 1").ScaleHeight 1.01, msoFalse, msoScaleFromBottomRight
With xlExcel.ActiveChart '标题
.HasTitle = True
.ChartTitle.Characters.Text = m_chartName
End With

xlExcel.ActiveChart.ChartArea.Select

xlExcel.ActiveSheet.ChartObjects("图表 1").Activate
xlExcel.ActiveChart.ChartArea.Select
xlExcel.ActiveSheet.Shapes("图表 1").ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
xlExcel.ActiveSheet.Shapes("图表 1").ScaleHeight 1.01, msoFalse, msoScaleFromTopLeft
xlExcel.ActiveSheet.Shapes("图表 1").ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
xlExcel.ActiveSheet.Shapes("图表 1").ScaleHeight 1.01, msoFalse, msoScaleFromTopLeft


xlExcel.ActiveChart.Legend.Select '右边标签
xlExcel.Selection.AutoScaleFont = True
With xlExcel.Selection.Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

xlExcel.Selection.Left = 320
xlExcel.Selection.Top = 10
xlExcel.Selection.Height = 344

xlExcel.ActiveChart.ChartArea.Select '整个图表
xlExcel.Sheets("Chart1").Select
xlExcel.ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"

xlExcel.ActiveSheet.Shapes("图表 1").ScaleWidth 1.01, msoFalse, msoScaleFromBottomRight
xlExcel.ActiveSheet.Shapes("图表 1").ScaleHeight 1.01, msoFalse, msoScaleFromBottomRight
xlExcel.ActiveSheet.Shapes("图表 1").IncrementLeft -19.5
xlExcel.ActiveSheet.Shapes("图表 1").IncrementTop -24#


xlExcel.ActiveChart.PlotArea.Select '中间图表
xlExcel.Selection.Left = 50
xlExcel.Selection.Top = 56
xlExcel.Selection.Width = 190
xlExcel.Selection.Height = 208
With xlExcel.Selection.Border
.ColorIndex = 2
.Weight = xlHairline
.LineStyle = xlNone
End With
With xlExcel.Selection.Interior
.ColorIndex = xlNone
.PatternColorIndex = 1
.Pattern = xlSolid
End With
xlExcel.Selection.Fill.Patterned Pattern:=msoPattern5Percent
With xlExcel.Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 2
.Fill.BackColor.SchemeColor = 2
End With


xlExcel.ActiveChart.ChartArea.Select '整个图表
xlExcel.ActiveChart.SeriesCollection(1).Select
xlExcel.ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
True, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
False, ShowValue:=True, ShowPercentage:=True, ShowBubbleSize:=False
''' xlExcel.ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
''' True, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
''' False, ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False

xlExcel.ActiveChart.SeriesCollection(1).DataLabels.Select
xlExcel.Selection.AutoScaleFont = True
With xlExcel.Selection.Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

xlExcel.ActiveChart.ChartTitle.Select '标题
xlExcel.Selection.AutoScaleFont = True

xlExcel.Selection.Left = 45
xlExcel.Selection.Top = 9
''
''
''' xlExcel.ActiveWindow.Visible = False
'''
''' xlExcel.Workbooks.Close
Set xlExcel = Nothing

End Sub
Private Sub Class_Initialize()
iCount = 0
foundErr = False
ErrMsg = ""
m_chartType = -4102 'xl3DPie
'54 '柱状图
End Sub

3、生成按钮事件代码:

''''''这里仅以商品号为对象,数据为它的 月购贷 "总数量" 或 "总金额"
Dim pic
Set pic = New pie ''创建要生成的图片的实例

Dim ds As ADODB.Recordset
Set ds = New ADODB.Recordset
Set ds = inMonthGrid.DataSource ''加载生成图片所需数据
''Set ds = dst
If ds.RecordCount > 0 Then '判断数据是否为空
If optionTongJi(0).value = True Then '判断数据是否为"总数量"
ds.MoveFirst
Do While ds.EOF = False
pic.AddValue CStr(ds.Fields("商品编号").value), CInt(ds.Fields("总数量").value)
ds.MoveNext
Loop
Else ''生成图片的数据为"金额"
ds.MoveFirst
Do While ds.EOF = False
pic.AddValue CStr(ds.Fields("商品编号").value), CDbl(ds.Fields("金额").value)
ds.MoveNext
Loop
End If
End If

pic.ChartName = Trim(txtMack.Text) ''图片标识

Select Case Trim(CStr(cmbStyle.Text)) ''图片类型

Case "饼图"
pic.ChartType = -4102
Case "条形图"
pic.ChartType = 54
Case "平面柱状图"
pic.ChartType = -4154
Case "折线图"
pic.ChartType = 4
End Select

pic.PicStart

在XP上,功能已经实现!