在VB组件内调用Excel2000实现GIF饼图

ZDNet软件频道 时间:2001-10-24 作者: |  我要评论()
本文关键词:VB
在这里,我将像大家介绍一个用vb编写的饼图组件,你只需要给它几个简单的参数,就可以生成一副GIF格式的图片给你。
转载自VB编程乐园


当我第一次使用excel的时候,就为excel的图表功能所倾倒,实在强大,并且那些图也挺漂亮了。后来我尝试着在VB里面调用excel所支持的VBa功能,发现功能的确强大,就是十分繁琐。后来就考虑用VB在excel外面包一层,写成对象,去掉我们不需要的特性。这样掉用起来就方便多了,所谓一劳永逸 :P。

在这里,我将像大家介绍一个用VB编写的饼图组件,你只需要给它几个简单的参数,就可以生成一副GIF格式的图片给你。调用例子如下:

Dim obj
Set obj = CreateObject("ChinaaspChart.pie")
obj.AddValue "男", 150
obj.AddValue "女", 45
obj.AddValue "不知道", 15
obj.ChartName = "性别比例图"
obj.FileName = "d:123.gif"
obj.SaveChart



除了在VB里面可以调用,这段代码同样也可以在asp里面调用。

下面编写我们的组件。

1.New project , 请选择activex dll,在project explorer面板上选择project1,然后在属性面板上修改其name为ChinaASPChart。同样把里面的class modules修改为pie

2.保存该project,将project存为chinaaspchart.VBp,将class1.cls存为pie.cls。

3.菜单project,选择菜单项References,然后请把Microsoft Active Server Pages Ojbect Library、Microsoft Excel 9.0 Object Library、COM+ Services Type Library选上。
注意:在NT4/win98上没有COM+ Service Type Library这个东东,应该选Microsoft Transaction Server Type Library

4.编辑pie.cls,代码如下:


注释:-------------------------------------------------------------------------------
Dim xl
Dim m_chartName
Dim m_chartData()
Dim m_chartType
Dim m_fileName
Public ErrMsg
Public foundErr
Dim iCount

Type m_Value
    label As String
    value As Double
End Type

Dim tValue As m_Value

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 SaveChart()
    On Error Resume Next
    Dim iSheet
    Dim i
    Set xl = New Excel.Application
    xl.Application.Workbooks.Add
    xl.Workbooks(1).Worksheets("sheet1").Activate
    If Err.Number <> 0 Then
        foundErr = True
        ErrMsg = Err.Description
        Err.Clear
    Else
        xl.Workbooks(1).Worksheets("sheet1").Cells("2,1").value = m_chartName
        For i = 1 To iCount
            xl.Worksheets("Sheet1").Cells(1, i + 1).value = m_chartData(i).label
            xl.Worksheets("Sheet1").Cells(2, i + 1).value = m_chartData(i).value
        Next
        xl.Charts.Add
        xl.ActiveChart.ChartType = m_chartType
        xl.ActiveChart.SetSourceData xl.Sheets("Sheet1").Range("A1:" & Chr((iCount Mod 26) + Asc("A")) & "2"), 1
        xl.ActiveChart.Location 2, "Sheet1"
        With xl.ActiveChart
            .HasTitle = True
            .ChartTitle.Characters.Text = m_chartName
        End With
        xl.ActiveChart.ApplyDataLabels 2, False, _
        True, False
        With xl.Selection.Border
            .Weight = 2
            .LineStyle = 0
        End With

        xl.ActiveChart.PlotArea.Select
        With xl.Selection.Border
            .Weight = xlHairline
            .LineStyle = xlNone
        End With
        xl.Selection.Interior.ColorIndex = xlNone

        xl.ActiveWindow.Visible = False

        xl.DisplayAlerts = False

        xl.ActiveChart.Export m_fileName, FilterName:="GIF"
        xl.Workbooks.Close
        If Err.Number <> 0 Then
            foundErr = True
            ErrMsg = ErrMsg
            Err.Clear
        End If
    End If
    Set xl = Nothing
End Sub

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

注释:-------------------------------------------------------------------------------


如果实现柱状图?
实际上前面的代码已经实现了柱状图的功能,只是缺省是饼图功能。调用代码改成如下:

Dim obj
Set obj = CreateObject("ChinaaspChart.pie")
obj.AddValue "男", 150
obj.AddValue "女", 45
obj.AddValue "不知道", 15
obj.ChartName = "性别比例图"
obj.FileName = "d:123.gif"
obj.ChartType=54
obj.SaveChart


在asp里面调用该组件画图并显示它需要注意的地方。


(1)图片必须生成在web目录下。
(2)asp程序运行在多用户环境下,必须加锁处理

可以通过application实现。其逻辑如下:

if application("标志")=0 then
    显示图片
else
    application.lock
    生成图片
    显示图片
    application("标志")=0
    application.unlock
end if


当然何时需要生成图片置标志位,就需要您自己根据程序的要求来确定了。


总结:

COM里面调用office组件是一个十分有用的技巧,它的优点是开发相对简单,使用方便,适合企业级低访问量,高业务要求的应用,缺点是占用系统资源高。

程序在Windows 2000 Server + Office 2000 + VB6.0 上测试通过。

责任编辑:胡海威

百度大联盟认证黄金会员Copyright© 1997- CNET Networks 版权所有。 ZDNet 是CNET Networks公司注册服务商标。
中华人民共和国电信与信息服务业务经营许可证编号:京ICP证010391号 京ICP备09041801号-159
京公网安备:1101082134