|
前几天我准备写一个在窗体上显示图表的模块，结果用Google查遍了整个网络，关于利用Excel VBA实现此功能的网页寥若晨星，而反复搜寻之后也终于让我有所得，有2位网友的解决方法比较好：
1、 http://club.excelhome.net/thread-345009-1-1.html ， 第4楼的HLAI网友提供方法很直接，其特点是容易实现，几乎不需要用VBA编程。但缺点也很明显，就是缺乏更复杂的扩展能力。
2、 http://club.excelhome.net/thread-243472-1-1.html 网友andysky 在 Excel home 论坛分享的一个方法，这个方法非常精妙，虽然复杂一点，但是跟用chartspace控件比起来要轻松多了。 这种思路是： 创建图表 →修改图表→存为图形文件→导入窗体的图形控件中→删除图形文件
编程中我认为比较重要的几个要点：
1、绘制图表前一定要先删除所有图表；
2、准备的数据必须有列标题，否则生成的图表很难看
3、一定要给生成的图表命名，这样后续的处理就比较容易了，否则非常麻烦。
4、生成的图表修改到多大合适，需要反复调试才行，不同的人有不同的口味。
5、别忘了删除图形文件，那只是一个临时的玩意。
我正是在andysky 网友解决思路的基础上，为自己刚开发的一个管理系统增加了一个完整的能耗数据的图表分析模块。（代码将近1500行，目前已经集成了31张表格）
真要感谢伟大的网络！如果没有网络，没有Excel吧吧主bengdeng的帮助，没有网上那么多网友的分享，很难想像我这样的计算机外行居然能够编写出一个近万行代码的管理软件。
在此，我也贴出我写的关于生成图表的代码中最核心的那一段，为其他网友再次编写类似代码时提供参考，主要是把我通过录制宏弄清楚的部分图表代码的含义与大家做一个分享。
调用该子程序前，需要编写为sheets("图表专用")准备数据的代码，相信对于需要这段代码的人而言没有困难。 能耗分析.分输量趋势图...等等之类都是窗体上创建的图形控件，当然可以随心所欲地另建。
Sub 绘制图表(图表类型 As Integer, 图表对象 As Integer)
Dim 数据区域 As Range
Dim 新图表 As ChartObject
Dim 文件名 As String
'选中要绘制图表的区域
On Error Resume Next
Set 数据区域 = Range(Cells(2, 1), Cells(数据区域最后一行, 数据区域最后一列))
Set 数据区域 = Range(Cells(2, 1), Cells(数据区域最后一行, 数据区域最后一列))
数据区域.Activate
Sheets("图表专用").ChartObjects.Delete '删除已经存在的图表
Set 新图表 = Sheets("图表专用").ChartObjects.Add(100, 0, 500, 290) '左边距，顶边距，宽，高
'Charts.Add '绘制图表
Select Case 图表类型
Case 1
新图表.Chart.ChartType = xlLineMarkers '图表类型为折线图
Case 2
新图表.Chart.ChartType = xlColumnStacked '图表类型为堆积柱形图
Case 3
新图表.Chart.ChartType = xl3DPie '图表类型为三维饼图
Case 4
新图表.Chart.ChartType = xlColumnClustered '图表类型为默认的柱形图
End Select
'图表数据源
新图表.Chart.SetSourceData Source:=数据区域, PlotBy:= _
xlColumns '图表数据源，产生在列
新图表.Chart.Location Where:=xlLocationAsObject, Name:="图表专用" '嵌入图表
'保留X轴刻度，保留Y轴刻度
If 图表类型 <> 3 Then
With 新图表.Chart
.HasAxis(xlCategory, xlPrimary) = True '有X轴
.HasAxis(xlvalue, xlPrimary) = True '有Y轴
End With
'X、Y轴线的类型自动
新图表.Chart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
'调整X轴格式
'新图表.Chart.Axes(xlCategory).TickLabels.NumberFormatLocal = "m"".""d" '日期格式为 “月.日”
With 新图表.Chart.Axes(xlCategory).TickLabels
.Alignment = xlCenter
.Offset = 100
.Orientation = xlUpward
.ReadingOrder = xlContext
.NumberFormatLocal = "d""日"""
End With
With 新图表.Chart.Axes(xlCategory).TickLabels.Font
.FontStyle = "常规"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End If
'关闭图例选项
新图表.Chart.HasLegend = False
'对于能耗组分堆积图或是饼图，必须显示图例选项
If 单位能耗.value = True Or 图表类型 = 3 Then
新图表.Chart.HasLegend = True '打开图例选项
新图表.Chart.Legend.Position = xlRight '靠右
End If
'如果绘制饼图，重新设置图例位置、绘图区位置及范围
If 图表类型 = 3 Then
'图例位置向上调，
With 新图表.Chart.Legend
.Left = 420
.Top = 40
End With
'绘图区适当拉伸
With 新图表.Chart.PlotArea
.Left = 25
.Top = 85
.Width = 445
.Height = 180
End With
End If
'图表缩放
ActiveSheet.Shapes(新图表.Name).ScaleWidth 0.61, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(新图表.Name).ScaleHeight 0.98, msoFalse, msoScaleFromTopLeft
'设置边框
With Selection.Border
.Weight = 2
.LineStyle = -1
End With
'颜色
With Selection.Interior
.ColorIndex = 34
.PatternColorIndex = 1
.Pattern = 1
End With
'图表边框倒圆角
Sheets("图表专用").DrawingObjects(新图表.Name).RoundedCorners = True
Sheets("图表专用").DrawingObjects(新图表.Name).Shadow = False
'设置标题内容
With 新图表.Chart
.HasTitle = True
.ChartTitle.Characters.Text = WS2.Range("A1").Text
End With
'设置标题格式，红色是3
新图表.Chart.ChartTitle.Select '选中标题
'Selection.AutoScaleFont = True
新图表.Chart.ChartTitle.AutoScaleFont = True
With Selection.Font
.Name = "黑体"
.FontStyle = "常规"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
.Background = xlAutomatic
End With
'设置绘图区的颜色
新图表.Chart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
'设置绘图区的填充色及填充方法
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.231372549019608
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 2
End With
' 将绘制并重新设置后的图表保存为一个临时的图片文件 → 导入窗体
文件名 = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
新图表.Chart.Export Filename:=文件名, filtername:="gif"
' 将临时的图片文件 → 导入窗体
Select Case 图表对象
Case 1
能耗分析.分输量趋势图.Picture = LoadPicture(文件名)
能耗分析.分输量趋势图.Visible = False
能耗分析.分输量趋势图.Visible = True
Case 2
能耗分析.输差趋势图.Picture = LoadPicture(文件名)
能耗分析.输差趋势图.Visible = False
能耗分析.输差趋势图.Visible = True
Case 3
能耗分析.单位能耗趋势图.Picture = LoadPicture(文件名)
能耗分析.单位能耗趋势图.Visible = False
能耗分析.单位能耗趋势图.Visible = True
Case 4
能耗分析.能耗指标趋势图.Picture = LoadPicture(文件名)
能耗分析.能耗指标趋势图.Visible = False
能耗分析.能耗指标趋势图.Visible = True
Case 5
能耗分析.绘制其它图表.Picture = LoadPicture(文件名)
能耗分析.绘制其它图表.Visible = False
能耗分析.绘制其它图表.Visible = True
End Select
'删除临时的图片文件
VBA.Kill 文件名
End Sub
Function 数据区域最后一行()
Sheets("图表专用").Select
Cells(2, 1).Select
Selection.End(xlDown).Select
数据区域最后一行 = ActiveCell.Row
End Function
Function 数据区域最后一列()
Sheets("图表专用").Select
Cells(2, 1).Select
Selection.End(xlToRight).Select
数据区域最后一列 = ActiveCell.Column
End Function
大家注意程序里的这一段重复的代码：
On Error Resume Next
Set 数据区域 = Range(Cells(2, 1), Cells(数据区域最后一行, 数据区域最后一列))
Set 数据区域 = Range(Cells(2, 1), Cells(数据区域最后一行, 数据区域最后一列))
这个代码还是有一点意义的。我在Excel吧和bengdeng版主探讨过这个问题（见http://www.excelba.com/bbs/Show.asp?bid=1&aid=2399 ），如果在调用该子程序之前，在程序里加一行 Sheets（”图表专用”）.select 确实是可以避免产生 Error ‘1004’，但是我对其它类似的代码反复调试之后，认为象这样即便在发生错误的时候也能使程序继续运行的方法，还是很值得保留在程序里的。
| 
IP卡
狗仔卡
发表于 2008-12-4 01:03
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
抢沙发
千斤顶
显身卡
