VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 使用VBA-EXCEL97绘图
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10690, 日期:2001-03-22
北京朝阳区安华西里
刘铮
---- EXCEL97是MICROSOFT公司出版的电子表格程序,它的处理数据的功能十分强大,但再好的软件都有它的一定的局限性,为了解决EXCEL97的局限性EXCEL97/2000内置了一个宏程序编辑器(如下图),以解决更多的人的更多需要。

---- 在日常工作中,我们经常使用到绘图程序,如用CAD绘制图形,如果想绘制一个要求精度不是太高的图纸那么CAD就有点大材小用了,如果只是作为您的参考:比如股市走向用它看看行情,那么您完全可以使用它———VBA FOR EXCEL97/2000皆可(全称为VISUAL BASIC FOR APPLICATION以后简称VBA)。

---- 一个网民曾经问过我:如果:给出X和Y轴能不能让EXCEL97的宏程序也划出一个曲线图呢?而不用EXCEL97的图表功能?

---- 为此我考虑使用EXCEL97中的SHAPE对象来编写这个程序,经过我的一天努力终于搞出了一段VBA程序,使用起来也十分方便!我想如果您认为可以近一步扩展,您还可以沿着我的思路,近一步深化编写,编写出一个自己满意的小程序!在启动EXCEL97时别忘记“启用宏”,否则无法运行!界面如上图.

---- 点击绘图按钮后,弹出对话框提示输入延伸的行数!(如果输入大于对话框中的值时将只得到曲线图没有数值) 如下图(略)

---- 绘制的图形如下(略):(并出现一个删图按钮,是删除图片用的!点击一下就可以删除您的曲线图了)

代码如下(把它放到模块中):
这段代码是绘制一个曲线图:
Sub drawing()
注释: Liuzheng welcome you to visit my homepage
http://grwy.online.ha.cn/vba_excel97/
    Range("a1").Select
    Selection.CurrentRegion.Select
myrow = Selection.Rows.Count
注释:计算行数
my = Application.InputBox("输入延伸的行数。"
& Chr(13) & Chr(13) & "提示:如果输入"
& myrow + 1 & ",将只绘制线条" & Chr(13)
& Chr(13) & "(没有数值!)",
"用VBA绘图", Default:=myrow)
注释:弹出输入对话框
    If my = Cancel Then
    Range("a1").Select
    Exit Sub
End If
注释:条件测试
    ActiveSheet.Shapes.SelectAll
Selection.Delete
注释:删除所有的SHAPES
    ActiveSheet.Buttons.Add(245.25, 34.5, 102, 36).Select
    b = Selection.Name
    Selection.OnAction = "del_shapes"
    ActiveSheet.Shapes(b).Select
    Selection.Characters.Text = "删图"
    With Selection.Characters(Start:=1, Length:=3).Font
        .Size = 22
        .Shadow = True
End With
注释:做一个删除按钮
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto,
Range("a2").Value, Range("b2").Value)
        For i = 3 To my
        If Range("a" & i).Value = ""
And Range("b" & i).Value = "" Then
        .ConvertToShape.Select
        Exit Sub
        End If
        .AddNodes msoSegmentCurve, msoEditingAuto,
Range("a" & i).Value, Range("b" & i).Value
        Next i
        .ConvertToShape.Select
    End With
For i = 2 To my
a = Range("a" & i).Value
b = Range("b" & i).Value
    ActiveSheet.Shapes.AddShape(msoShapeRectangle,
a, b, 48.75, 21).Select
    Selection.Characters.Text = a & "," & b
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Times New Roman"
    End With
    Selection.HorizontalAlignment = xlCenter
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    ActiveSheet.Shapes.AddShape(msoShapeOval, a, b, 1.5, 1.5).Select
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Next I
注释:以上是用VBA绘图

MsgBox "欢迎参观我的个人主页
http://grwy.online.ha.cn/vba_excel97/或者
http://202.102.233.10/64215258/", vbInformation, "用VBA绘图"
    Range("B1").Select
End Sub

注释:这段代码为:删除图片,并再做一个绘图按钮
Sub del_shapes()
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
    Application.ScreenUpdating = False
    ActiveSheet.Buttons.Add(245.25, 34.5, 102, 36).Select
    b = Selection.Name
    Selection.OnAction = "drawing"
    ActiveSheet.Shapes(b).Select
    Selection.Characters.Text = "绘图"
    With Selection.Characters(Start:=1, Length:=3).Font
        .Size = 22
        .Shadow = True
    End With
    Range("B1").Select
End Sub

---- 以上程序在EXCEL97和2000中调试通过!
---- 注意在启动EXCEL97时别忘记“启用宏”,否则无法运行