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上,功能已经实现!