使用VBA-Excel97繪圖

2019-11-18 17:49:38

字體：大中小

來源：轉載

供稿：網友

----Excel97是MICROSOFT公司出版的電子表格程序，它的處理數據的功能十分強大，但再好的軟件都有它的一定的局限性，為了解決EXCEL97的局限性EXCEL97/2000內置了一個宏程序編輯器(如下圖)，以解決更多的人的更多需要。

----在日常工作中，我們經常使用到繪圖程序，如用CAD繪制圖形，如果想繪制一個要求精度不是太高的圖紙那么CAD就有點大材小用了，如果只是作為您的參考：比如股市走向用它看看行情，那么您完全可以使用它———VBAFOREXCEL97/2000皆可（全稱為VISUALBASICFORapplication以后簡稱VBA）。

----一個網民曾經問過我：如果：給出X和Y軸能不能讓EXCEL97的宏程序也劃出一個曲線圖呢？而不用EXCEL97的圖表功能?

----為此我考慮使用EXCEL97中的SHAPE對象來編寫這個程序，經過我的一天努力終于搞出了一段VBA程序，使用起來也十分方便!我想如果您認為可以近一步擴展，您還可以沿著我的思路，近一步深化編寫，編寫出一個自己滿意的小程序！在啟動EXCEL97時別忘記“啟用宏”，否則無法運行！界面如上圖.

----點擊繪圖按鈕后，彈出對話框提示輸入延伸的行數！(如果輸入大于對話框中的值時將只得到曲線圖沒有數值)如下圖(略)

----繪制的圖形如下(略)：(并出現一個刪圖按鈕，是刪除圖片用的！點擊一下就可以刪除您的曲線圖了)

代碼如下（把它放到模塊中）：
這段代碼是繪制一個曲線圖：
Subdrawing()
'Liuzhengwelcomeyoutovisitmyhomepage
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)
'彈出輸入對話框
　　Ifmy=CancelThen
　　Range("a1").Select
　　ExitSub
EndIf
'條件測試
　　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="刪圖"
　　WithSelection.Characters(Start:=1,Length:=3).Font
　　　　.Size=22
　　　　.Shadow=True
EndWith
'做一個刪除按鈕
　　WithActiveSheet.Shapes.BuildFreeform(msoEditingAuto,
Range("a2").Value,Range("b2").Value)
　　　　Fori=3Tomy
　　　　IfRange("a"&i).Value=""
AndRange("b"&i).Value=""Then
　　　　.ConvertToShape.Select
　　　　ExitSub
　　　　EndIf
　　　　.AddNodesmsoSegmentCurve,msoEditingAuto,
Range("a"&i).Value,Range("b"&i).Value
　　　　Nexti
　　　　.ConvertToShape.Select
　　EndWith
Fori=2Tomy
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
　　WithSelection.Characters(Start:=1,Length:=6).Font
　　　　.Name="TimesNewRoman"
　　EndWith
　　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
NextI
'以上是用VBA繪圖

MsgBox"歡迎參觀我的個人主頁
http://grwy.online.ha.cn/vba_excel97/或者
http://202.102.233.10/64215258/",vbInformation,"用VBA繪圖"
　　Range("B1").Select
EndSub

'這段代碼為：刪除圖片,并再做一個繪圖按鈕
Subdel_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="繪圖"
　　WithSelection.Characters(Start:=1,Length:=3).Font
　　　　.Size=22
　　　　.Shadow=True
　　EndWith
　　Range("B1").Select
EndSub

----以上程序在EXCEL97和2000中調試通過!
----注意在啟動EXCEL97時別忘記“啟用宏”，否則無法運行！->

上一篇：創建一個簡單的OLEDB提供者

下一篇：在Word中嵌入應用程序