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

2/27/2006来源:Visual Basic教程人气:9557

当我第一次使用Excel的时候,就为excel的图表功能所倾倒,实在强大,并且那些图也挺漂亮了。后来我尝试着在vb里面调用excel所支持的vba功能,发现功能的确强大,就是十分繁琐。后来就考虑用vb在excel外面包一层,写成对象,去掉我们不需要的特性。这样掉用起来就方便多了,所谓一劳永逸:P。
  在这里,我将像大家介绍一个用vb编写的饼图组件,你只需要给它几个简单的参数,就可以生成一副GIF格式的图片给你。调用例子如下:

Dimobj
Setobj=CreateObject("ChinaaspChart.pie")
obj.AddValue"男",150
obj.AddValue"女",45
obj.AddValue"不知道",15
obj.ChartName="性别比例图"
obj.FileName="d:\123.gif"
obj.SaveChart
  除了在vb里面可以调用,这段代码同样也可以在asp里面调用。

  下面请followme编写我们的组件。
  1.NewPRoject,请选择activexdll,在projectexplorer面板上选择project1,然后在属性面板上修改其name为ChinaASPChart。同样把里面的classmodules修改为pie

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

  3.菜单project,选择菜单项References,然后请把MicrosoftActiveServerPagesOjbectLibrary、MicrosoftExcel9.0ObjectLibrary、COM ServicesTypeLibrary选上。
注意:在NT4/win98上没有COM ServiceTypeLibrary这个东东,应该选MicrosoftTransactionServerTypeLibrary

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


注释:-------------------------------------------------------------------------------
Dimxl
Dimm_chartName
Dimm_chartData()
Dimm_chartType
Dimm_fileName
PublicErrMsg
PublicfoundErr
DimiCount
Typem_Value
labelAsString
valueAsDouble
EndType
DimtValueAsm_Value
PublicPropertyLetChartType(ChartType)
m_chartType=ChartType
EndProperty
PublicPropertyGetChartType()
ChartType=m_chartType
EndProperty

PublicPropertyLetChartName(ChartName)
m_chartName=ChartName
EndProperty
PublicPropertyGetChartName()
ChartName=m_chartName
EndProperty
PublicPropertyLetFileName(fname)
m_fileName=fname
EndProperty
PublicPropertyGetFileName()
FileName=m_fileName
EndProperty

PublicSubAddValue(label,value)
iCount=iCount 1
ReDimPreservem_chartData(iCount)
tValue.label=label
tValue.value=value
m_chartData(iCount)=tValue
EndSub
PublicSubSaveChart()
OnErrorResumeNext
DimiSheet
Dimi
Setxl=NewExcel.application
xl.Application.Workbooks.Add
xl.Workbooks(1).Worksheets("sheet1").Activate
IfErr.Number<>0Then
foundErr=True
ErrMsg=Err.Description
Err.Clear
Else
xl.Workbooks(1).Worksheets("sheet1").Cells("2,1").value=m_chartName
Fori=1ToiCount
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.SetSourceDataxl.Sheets("Sheet1").Range("A1:"&Chr((iCountMod26) Asc("A"))&"2"),1
xl.ActiveChart.Location2,"Sheet1"
Withxl.ActiveChart
.HasTitle=True
.ChartTitle.Characters.Text=m_chartName
EndWith
xl.ActiveChart.ApplyDataLabels2,False,_
True,False
Withxl.Selection.Border
.Weight=2
.LineStyle=0
EndWith

xl.ActiveChart.PlotArea.Select
Withxl.Selection.Border
.Weight=xlHairline
.LineStyle=xlNone
EndWith
xl.Selection.Interior.ColorIndex=xlNone

xl.ActiveWindow.Visible=False

xl.DisplayAlerts=False

xl.ActiveChart.Exportm_fileName,FilterName:="GIF"
xl.Workbooks.Close
IfErr.Number<>0Then
foundErr=True
ErrMsg=ErrMsg
Err.Clear
EndIf
EndIf
Setxl=Nothing
EndSub
PrivateSubClass_Initialize()
iCount=0
foundErr=False
ErrMsg=""
m_chartType=-4102注释:xl3DPie
注释:54注释:柱状图
EndSub
注释:-------------------------------------------------------------------------------

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

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

  6.在asp里面调用该组件画图并显示它需要注意的地方。
  (1)图片必须生成在web目录下。
  (2)asp程序运行在多用户环境下,必须加锁处理
  可以通过application实现。其逻辑如下:

 ifapplication("标志")=0then
显示图片
else
application.lock
生成图片
显示图片
application("标志")=0
application.unlock
endif
当然何时需要生成图片置标志位,就需要您自己根据程序的要求来确定了。


总结:
  COM里面调用office组件是一个十分有用的技巧,它的优点是开发相对简单,使用方便,适合企业级低访问量,高业务要求的应用,缺点是占用系统资源高。
  程序在Windows2000Server Office2000 VB6.0上测试通过。->