2018年12月02日

如何利用Excel作VB程式之資料輸入

1.前言

Excel是什麼？Excel檔案是一個活頁簿（Workbook），也是一個Project。一個活頁簿包含許多工作表(WorkSheets)，工作表是由欄（Columns）與列（Rows）間之儲存格(Cells)所組成[每一個工作表有256列(2^8)，65536欄(2^16)，每一個儲存格可存放32767(=2^15-1)中英字元]。Excel是一套智慧型電腦試算表（Spread Sheet），可以使用在工程計算、資料統計、資料排序、圖表製作，甚至於股票分析、公司資產及庫存分析、商業或營建工程等管理決策分析等，應用範圍十分普遍、廣泛。Excel有三百多個工作表函數及不計其數之外部程式。Excel多可以像一般商業軟體一樣，可拿來開發複雜之計算程序。Excel VBA可以做的事更多，他可以像一般軟體一樣，可以開發比較複雜及重複性計算多之程式。Excel VBA可以提高工作表計算效率、減少程式篇幅，提昇程式可看性、促進程式自動化功能等等。Excel VBA 可以呼叫外部執行程式(包含Ms_Dos版)，利用Excel作為其他程序之輸入樣板(Input template)能使您的輸入工作更簡便；以Excel工作表做為輸出表格檔後，更能利用工作表函數分析及美化圖表及報告；Excle亦可以製作報告封面及撥放音樂；從網路上直接擷取資料，還有其他功能………。

有關如何利用Excel及Excel VBA作複雜之程式設計之詳細內容，有興趣之讀者可參考筆者另一著作『Excel在邊坡工程之應用(戴清河，2008，科技圖書)』。

一般市面上常用之商業繪圖程式，大多不考慮以輸入大量資料來繪製圖形，就算有，也是相當複雜煩瑣，有的更必須由使用者自行編寫程式方配合。舉例來說如果讀者因工作需要繪製如y=3sin(5x)cos(x)+exp(x)，或z=5x(x+3y)之圖形，則一般Cad程式可能無法直接以輸入公式方式處理。您是可以先將自變數區分為若干段分別代入公式，分段繪製方式完成，但等畫完後您可能已精疲力盡，而成果是否

達到要求還必須再確認？當然如您有數學專用軟體如MatLab(Matrix Labaratory)

、CAS(Computer Algebra System)、Methmatica或Maple,Derive就另當別論。如果沒有，您可以自己D.I.Y一番，利用Excel來完成它。下面所要介紹就是如何利用Excel來做VB畫圖程式，或以Excel工作表作為Ms_Dos版本之執行程式之輸入樣板及利用其輸出成果以繪製圖形之觀念。

2.Excel工作表公式輸入方式介紹

計算是Excel 最重要之功能之一。Excel公式和一般數學公式類似，而Excel公用函數則與一般電腦程式(序)之庫存函數相似。如工作表中A1:A5儲存格分別儲存1、3、5、7及9數值，則計算A1:A5之總和『=A1+A2+A3+A4+A5』=25為公式計算方式；而利用Excel工作表公用函數SUM()則為『SUM(A1:A5)』=25。工作表函數可以有引數（Arguments），也可以不需要引數如π(PI()函數)者，但一般公用函數多需要引數，前述之A1:A5就是SUM()之引數。

2.1 公式介紹

不論是公式或函數都是以等號”=”開頭，公式是由位址、定義名稱或函數與運算符號所組成。函數之引數可以是數值、位址、定義名稱、陣列等。

Excel 的公式大體上可分成三種：

各運算符號之優先順序如下表所示。

有關公式運算時應注意下列幾項規則：

(1)公式中如優先順序相同者，運算是由左至右。

(2)可以小括弧改變運算次序，小括弧內者優先處理。

(3)負號不需另外使用小括弧。

(4)公式中容許使用函數當引數，如『=SUM(5+SUM(A2:F2))』。

2.1 公式輸入介紹

在介紹Excel公式輸入前，讓我們先介紹公式輔助輸入器，公式輔助輸入器是在資料編輯列與名稱方塊間之三個按鈕                             ，當我們在作用儲存格輸入”=”時，此三個按鈕便立即出現。Excel 公式輸入相當簡單，一般而言，

(1)可在作用儲存格直接輸入如『=A2+B2+C2+D2+E2』，後直接按ENTER或滑鼠左鈕。

(2)在資料編輯列內點選”=”，然後輸入”A2+B2+C2+D2+E2”，再點選 ü。

第(1)種輸入方式要輸入”A2”時，是可以改採用滑鼠點選儲存格A2代替，其餘”B2”、”C2”、”D2”及” E2”亦同。

3. 函數介紹

Excel公用函數，其名稱是內定的。公用函數除極少數之常數函數如PI()、TRUE()或FALSE()等外多需要引數，所謂引數就是函數在運算時，需要輸入之數值、位址、作用範圍、文字、其他函數資料。如TAN(PI()/4.)中PI()/4.就是TAN()函數之引數，公用函數一般多由(1)函數名稱，(2)小括弧( )，及(3)引數所組成。

4. 名稱定義

在Excel儲存格輸入冗長之計算公式比較容易出錯，因此屬常數或全域變數(Global variables，指在同一個活頁簿中之共同變數)名稱，便可利用「插入(I)/名稱(N)/定義(D)」工具，將該常數或全域變數以特定名稱定義以方便作業。如前數之數學函數公式中x或(x，y)定義為Xx或(Xx，Yy)。為何一定要將其名稱定義，此部份是我們利用Excel工作表設計一個通用繪製程式之重要觀念，首先觀察如下圖之工作表，本工作表主要是為繪製任何三維函數圖形所設計者。舉例來說，如果我們要畫方程式z=8.0[0.25(x+y)]在(-8≦x≦8，-8≦y≦8)範圍內之圖形，而且我們也要設計好之繪畫程式能適用在所有之外顯型函數，如果您朋友不會編寫VB程式，但他想分享您的成果，而您手上僅有Excel軟體(合法)那麼您應該如何完成使命？

表4.1a三維函數資料轉譯工作表

表4.1b三維函數資料轉譯工作表

在設計整個繪圖程式前必須先瞭解Excel工作表中變數名稱定義與VB或Excel VBA變數名稱之差異。以公式z=8.0[0.25(x+y)]來說，如在Excel任何一個工作表中將其定義為Xx,Yy(大小寫不分)，則在同一個活頁簿(WorkSheet)中任何儲存格都可以引用它，它是屬全域變數，其值永遠等於您定義它為Xx或Yy處之儲存格所存放之資料(文字、數據或公式等)；而在VB或Excel VBA所定義之Xx或Yy變數其資料型態，完全取決您是如何宣告，其可為整數或實數，至於是屬全域變數或局部變數則視以Public或Dim宣告及其擺放位置而定。如表4.1a將儲存格A6及B6分別定義為XX及YY，D6儲存公式=8*EXP(0.25*(XX*XX+YY*YY))，則在同一個Project(即活頁簿)工作中，如引用xx(或Xx，或XX)時其值都等於A6所存放之資料，如A6及B6分別儲存-8與8，則D6=8*(0.25*((-8)*(-8)+(8)*(8)))。Excel工作表有如此特性，因此我們可以利用其來轉譯及建立自變數變化範圍為(-8≦x≦8，-8≦y≦8)之資料檔案。

5.建立資料檔

設計三維函數繪圖VB電腦程式，如果有合法之VB電腦程式開發軟體，您可以直接以自訂函數來計算Z=8*EXP*(0.25*(XX*XX+YY*YY))值及繪製函數圖形；如果沒有，就只好退而求其次，利用Excel工作表繪製函數圖。最直接之方法是可準備類似如表5.1之資料，將xy設定成x=8,y=-8，x=8,y=-7，x=8,y=-6，……x=-8,y=7，x=-8,y=8以計算對應之z值，然後分條(固定x，y=-8~8)，分段(y=-8~-7，y=-7~-6，……)畫線，逐條完成。不過這種方式實在太不科學也完全沒有考慮到自動化。

下面我們所介紹之方式，原則與上述方法相似，但採全自動化作業。工程表(表5.1)中儲存格A6及B6，只存放xx(再次提醒不分大小寫)及yy值，而C6存放公式，因此我們可以設計一個小程式：

(a)將自變數xx及yy變化翻範圍及每次計算增量(儲存格A4、B4、C4及E4、F4、G4)傳遞給程序。

(b)然後由程序自動指派xx及yy值給工作表儲存格A6及B6。

(c)由工作表依C6所儲存之公式以計算z值，計算完成後z值再回傳程式

(d)由程式自動將每一組之(x,y,z)寫入資料檔案中。如此重複進行直至x=-8，=8為止。為區別每一條線，我們可以在xx變化時第一筆資料之旗標(Iflag)設定為0，其餘則Iflag=1以為區分。

(e)由VB程式或Excel VBA滑製圖形。

表5.1三維函數資料表

下面為建立資料檔案及複製公式之程式碼，是不是很簡單？資料計分兩組，檔案名稱為內定，無法在工作表變更檔名，如須改名稱則需在原程式碼修改。Excel此種規定，應該是在防止非程式開發者胡亂修改資料檔案？資料檔案中之”c:\電腦製圖\三維函數xyzA.inp"是固定xx變化yy的曲線資料；另"c:\電腦製圖\三維函數xyzB.inp"是固定yy變化xx的曲線資料。如此利用兩組資料繪製之曲線時便成格網形狀。

Private Sub CopyEquation_Click()   ‘複製公式

Dim StEq As String

StEq = Range("B2")

Range("D6") = "=" & StEq

End Sub

Private Sub 建立資料檔案_Click()

Dim Xmin As Single, Xmax As Single, DelX As Single

Dim Ymin As Single, Ymax As Single, DelY As Single

Dim Filename1 As String, Fileno1 As Integer, Filename2 As String, Fileno2 As Integer

Dim Xx As Single, Yy As Single, Zz As Single, Iflag As Integer

Fileno1 = FreeFile

Open "c:\電腦製圖\三維函數xyzA.inp" For Output As Fileno1 ’內定檔案名稱

Fileno2 = FreeFile

Open "c:\電腦製圖\三維函數xyzB.inp" For Output As Fileno2 ’內定檔案名稱

Xmin = Range("A4")

Xmax = Range("B4")

DelX = Range("C4")

Ymin = Range("E4")

Ymax = Range("F4")

DelY = Range("G4")

For Xx = Xmin To Xmax Step DelX    ‘固定xx變化yy的曲線

Iflag = 0                            ‘旗標=0

For Yy = Ymin To Ymax Step DelY

Range("A6") = Xx

Range("B6") = Yy

Zz = Range("D6")

Print #Fileno1, Xx; Yy; Zz; Iflag;’資料寫入檔案"c:\電腦製圖\三維函數xyz1.inp"

Iflag = 1                            ‘旗標=1

Next Yy

Print #Fileno1, " "

Next Xx

Close #Fileno1

For Yy = Ymax To Ymin Step –DelY    ‘固定yy變化xx的曲線

Iflag = 0

For Xx = Xmin To Xmax Step DelX

Range("A6") = Xx

Range("B6") = Yy

Zz = Range("D6")

Print #Fileno2, Xx; Yy; Zz; Iflag;’資料寫入檔案"c:\電腦製圖\三維函數xyz1.inp"

Iflag = 1

Next Xx

Print #Fileno2, " "

Next Yy

Close #Fileno2

End Sub

下面是根據Private Sub建立資料檔案_Click()程序所建立之檔案

"c:\電腦製圖\三維函數xyzA.inp"中之部分內容，第一曲線第一筆資料為(8 -8  6.317037E+14  0)，同條曲線最後一筆資料為(8  8  6.317037E+14  1)，第二條曲線第一筆資料為(7 -8  1.485625E+13  0)，此處要特別注意每一條第一筆資料之旗標都是0，資料是以空格區分，因此以後要由此檔案讀入(x,y,z,Iflag)資料時，也只能以空格分離資料。

6.Excel VB繪圖方法簡介

Excel VBA所提供的繪圖工具是沒有VB多樣及實用，Excel VBA可以用來畫圖之方法主要有Addline(畫線)、Addshape(畫圖案)、Addcurve(Bessel函數曲線)、AddDdiagram(建立圖案)、Addpolyline(集合線)、Buildfreeform(任意多邊形)等；書寫文字之工會及方法，則有Callout(圖說文字)、Addlabel(可以書寫垂直文字標籤)、Addtextbox(建立文字方塊)等。畫圖方法中，除畫線及畫圖案外，其餘在利用工作表作畫布之Excel VBA電腦繪圖程式中，作用似乎相當有限。當然，Excel VBA本身就不是為開發電腦繪圖程式所設計，我們把它用來設計簡單之繪圖程式使用，只不過是增加其邊際效益而已，反正不用白不用？上述所介紹之畫圖方法及屬性，座標原點都是以文件(主要為工作表)左上角，x軸朝右y軸朝下，與我們一般常用之x軸朝右y軸朝上的習慣並不十分契合，因此使用起來總是有些不方便，另外上述之畫圖方法或屬性之參數比較複雜，因此筆者特將常用之畫線、畫橢圓(含園)、畫框等改寫成以座標原點(x軸朝右y軸朝上)為參考點之自訂程序供讀者參考。為方便說明，此處之立體圖示也捨棄前面透視投影圖之觀念，利用線性轉換三度空間轉換至二維平面之觀念以立體斜交座標系統(Skewed axes xy-coordinatevsystem)表示方式呈現圖形。如圖6.1之圖示，新x’軸與原三軸互相垂直之x軸夾角為α，新y’軸與原y軸夾角為β，新z’軸與原x軸夾角為γ，z軸伸縮係數為k。則由三角形ABC正弦定理可得出：

x’=x+y+kz                             (6.1a)

y’=x+y+kz                             (6.1b)

以矩陣方式表示為：

=                         (6.2)

上述公式(6.2)如令α=0，β=0，k=0.5時，則公式(6.2)就變成傾斜投影(oblique projection)之箱匣投影(Cabinet projection)：

=                         (6.2)

6.1繪圖程式設計

Excel VBA畫圖方法中有關畫線Addline及畫圖案Addshape方法，尤其是畫線可以以說是Excel VBA畫圖中最基本的方法，有Addline方法後，其餘畫圖方法多可以以自訂程序來完成。利用Excel VBA畫圖要在圖上寫字或標示數字似乎就比較麻煩，雖然可以利用可以在shapes圖案中寫字或利用Callout、Addlabel、Addtextbox方式處理，但上述方法的寫字外框多會遮蓋住部份圖形線條。以下是筆者將常用幾種畫圖方法改寫成以x軸朝右y軸朝下之程式碼。

Public Sub 畫線(直線起點_H As Single, 直線起點_V As Single, 直線終點_H As Single, _直線終點_V As Single, 線形代號 As Integer, 線寬代號 As Integer, 紅色指數 As Integer, 綠色指數 As Integer, 藍色指數 As Integer)

Dim 直線起點左 As Single, 直線起點上, 直線終點右 As Single, 直線終點下 As Single

直線起點左 = Scren_cenH + 直線起點_H

直線起點上 = Scren_cenV - 直線起點_V

直線終點右 = Scren_cenH + 直線終點_H

直線終點下 = Scren_cenV - 直線終點_V

With ActiveSheet.Shapes.AddLine(直線起點左, 直線起點上, 直線終點右, 直線終點下).Line

    .DashStyle = 線形代號

    .Weight = 線寬代號

    .ForeColor.RGB = RGB(紅色指數, 綠色指數, 藍色指數)

End With

End Sub

Public Sub 畫框及寫字(框下水平位置座標 As Single, 框下垂直位置座標 As Single, 框寬 As Single, _ 框高 As Single, 文字內容 As String, 字體 As String, 大小 As Integer, 字紅色指數 As Integer, 字綠色指數 As Integer, 字藍色指數 As Integer, 外框色代號 As Integer)

Dim 框起點左 As Single, 框起點上 As Single

框起點左 = Scren_cenH + 框下水平位置座標 + 框寬

框起點上 = Scren_cenV - 框下垂直位置座標 - 框高

 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 框起點左, 框起點上, 框寬, 框高).Select

 Selection.Characters.Text = 文字內容

With Selection.Characters(Start:=1, Length:=5).Font

.Style=字體      ‘如細明體

.Size =大小

.Color = RGB(字紅色指數, 字綠色指數, 字藍色指數)

End With

With Selection.ShapeRange.Line

 .ForeColor.SchemeColor = 外框色代號 '=1外框變成白色

 End With

End Sub

Public Sub 圖案及寫字(圖案編號 As Integer, 框下水平位置座標 As Single, 框下垂直位置座標 As Single, 框寬 As Single, _框高 As Single, 文字內容 As String, 字體 As String, 大小 As Integer, 字紅色指數 As Integer, 字綠色指數 As Integer, 字藍色指數 As Integer, 外框色代號 As Integer)

Dim 框起點左 As Single, 框起點上 As Single

框起點左 = Scren_cenH + 框下水平位置座標 + 框寬

框起點上 = Scren_cenV - 框下垂直位置座標 - 框高

 ActiveSheet.Shapes.AddShape(圖案編號, 框起點左, 框起點上, 框寬, 框高).Select

 Selection.Characters.Text = 文字內容

With Selection.Characters(Start:=1, Length:=5).Font

.Style=字體      ‘如細明體

.Size =大小

.Color = RGB(字紅色指數, 字綠色指數, 字藍色指數)

End With

With Selection.ShapeRange.Line

 .ForeColor.SchemeColor = 外框色代號     '=1外框變成白色

 End With

End Sub

Public Sub 畫圓及寫字(圓心水平位置座標 As Single, 圓心垂直位置座標 As Single, 半徑 As Single, _文字內容 As String, 字體 As String, 大小 As Integer, 字紅色指數 As Integer, 字綠色指數 As Integer, 字藍色指數 As Integer, 外框色代號 As Integer)

Dim 框起點左 As Single, 框起點上 As Single, 框寬 As Single, 框高 As Single

框起點左 = Scren_cenH + 圓心水平位置座標 - 半徑

框起點上 = Scren_cenV - 圓心垂直位置座標 - 半徑

框寬 = 半徑 * 2

框高 = 半徑 * 2

ActiveSheet.Shapes.AddShape(msoShapeOval, 框起點左, 框起點上, 框寬, 框高).Select

 Selection.Characters.Text = 文字內容

With Selection.Characters(Start:=1, Length:=5).Font

.Style=字體      ‘如細明體

.Size =大小

.Color = RGB(字紅色指數, 字綠色指數, 字藍色指數)

End With

With Selection.ShapeRange.Line

 .ForeColor.SchemeColor = 外框色代號 '=1外框變成白色

 End With

End Sub

Public Sub Allshapes_delete()     ‘清除儲存格

ActiveSheet.Range("A1:W100").Delete

End Sub

  Public Sub 畫箭頭(直線虛實代號 As Integer, 箭頭起點_H As Single, 箭頭起點_V As Single, 箭頭終點_H As Single, _箭頭終點_V As Single, 紅色指數 As Integer, 綠色指數 As Integer, 藍色指數 As Integer)

     'BeginX   , BeginY  必選的 Single。相對於文件的左上角，以點為單位指定直線的起點位置。

     'EndX   , EndY  必選的 Single。相對於文件的左上角，以點為單位指定直線的終點位置。

     Dim 箭頭起點左 As Single, 箭頭起點上, 箭頭終點右 As Single, 箭頭終點下 As Single

箭頭起點左 = 箭頭起點_H + Scren_cenH

箭頭起點上 = Scren_cenV - 箭頭起點_V

箭頭終點右 = 箭頭終點_H + Scren_cenH

箭頭終點下 = Scren_cenV - 箭頭終點_V

With ActiveSheet.Shapes.AddLine(箭頭起點左, 箭頭起點上, 箭頭終點右, 箭頭終點下).Line

    .DashStyle = 直線虛實代號        '如msoLineDashDotDot代號為6,msolineSolid代號為1

    .ForeColor.RGB = RGB(紅色指數, 綠色指數, 藍色指數)

    .BeginArrowheadLength = msoArrowheadShort

    .BeginArrowheadStyle = msoArrowheadOval

    .BeginArrowheadWidth = msoArrowheadNarrow

    .EndArrowheadLength = msoArrowheadLong

    .EndArrowheadStyle = msoArrowheadTriangle

    .EndArrowheadWidth = msoArrowheadWide

    End With

 End Sub

下面為三維函數f(xx,yy)=8.*exp(-0.15*(xx*xx+yy*yy))利用Excel VBA繪圖之程式碼。

Private Sub Cmd3DFdig_Click()

Dim Fileno1 As Integer, Fileno2 As Integer

Dim Nop_I As Integer, Coord(1500, 3) As Single, Xmin_orgI As Single, Ymin_orgI As Single, Zmin_orgI As Single

Dim Xmax_orgI As Single, Ymax_orgI As Single, Zmax_orgI As Single, Iflag(1500) As Integer

Dim Xtpt As Single, Ytpt As Single, Ztpt As Single, Iflagtpt As Integer, I As Integer

Dim X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, Xyz_minI(3) As Single, Xyz_maxI(3) As Single

Dim St1 As String, AngXp_X As Single, AngYp_Y As Single, AngZp_X As Single, Xout As Single, Yout As Single

Fileno1 = FreeFile

Open "c:\電腦製圖\三維函數xyzA.inp" For Input As Fileno1

Call datain(8)

'********3D函數原始資料讀入

Sheet1.Range("E19") = "xy軸比例"

    Sheet1.Range("E20") = "螢幕半高"

    Sheet1.Range("E21") = "螢幕半寬"

    Sheet1.Range("E22") = "新x舊x夾角"

    Sheet1.Range("E23") = "新y舊y夾角"

    Sheet1.Range("E24") = "新z舊x夾角"

    Sheet1.Range("E25") = "z軸伸縮係數"

    Xyscale = Sheet1.Range("G19")   'xy軸比例

    Scren_cenV = Sheet1.Range("G20")   '螢幕半高

    Scren_cenH = Sheet1.Range("G21")  '螢幕半寬

    AngXp_X = Sheet1.Range("G22")   '新x舊x夾角

    AngYp_Y = Sheet1.Range("G23")   '新y舊y夾角

    AngZp_X = Sheet1.Range("G24")   '新z舊x夾角

    Kfct = Sheet1.Range("G25")      'z軸伸縮係數

    Sheet2.Select

    Call Allshapes_delete

           Nop_I = 0

       Do While Not EOF(Fileno1)

        Nop_I = Nop_I + 1

        Input #Fileno1, Xtpt, Ytpt, Ztpt, Iflagtpt

        Coord(Nop_I, 1) = Xtpt

        Coord(Nop_I, 2) = Ytpt

        Coord(Nop_I, 3) = Ztpt

        Iflag(Nop_I) = Iflagtpt

         Loop

       Call 最小座標2(Nop_I, Coord(), Xyz_minI())

       Call 最大座標2(Nop_I, Coord(), Xyz_maxI())

        Xmin_orgI = Xyz_minI(1)

        Ymin_orgI = Xyz_minI(2)

        Zmin_orgI = Xyz_minI(3)

        Xmax_orgI = Xyz_maxI(1)

        Ymax_orgI = Xyz_maxI(2)

        Zmax_orgI = Xyz_maxI(3)

        Call R3TranR2(AngXp_X, AngYp_Y, AngZp_X, Xmin_orgI, Ymin_orgI, Zmin_orgI, 0.5, Xout, Yout)

        Xmin_orgI = Xout * X方格長 * Xyscale

        Ymin_orgI = Yout * Y方格長 * Xyscale

        Call R3TranR2(AngXp_X, AngYp_Y, AngZp_X, Xmax_orgI, Ymax_orgI, Zmax_orgI, 0.5, Xout, Yout)

        Xmax_orgI = Xout * X方格長 * Xyscale

        Ymax_orgI = Yout * Y方格長 * Xyscale

        For I = 1 To Nop_I - 1

        Call R3TranR2(AngXp_X, AngYp_Y, AngZp_X, Coord(I, 1), Coord(I, 2), Coord(I, 3), 0.5, Xout, Yout)

        X1 = Xout * X方格長 * Xyscale

        Y1 = Yout * X方格長 * Xyscale

        Call R3TranR2(AngXp_X, AngYp_Y, AngZp_X, Coord(I + 1, 1), Coord(I + 1, 2), Coord(I + 1, 3), 0.5, Xout, Yout)

        X2 = Xout * X方格長 * Xyscale

        Y2 = Yout * X方格長 * Xyscale

        If Iflag(I) = 0 Then

        St1 = Trim(Str(Coord(I, 1)))

        Call 畫框及寫字(X1 - 2 * Xyscale, Y1, 15, 15, St1, "ITALIC ", 6, 150, 0, 0, 1)

              End If

        If Iflag(I) = 1 And Iflag(I + 1) = 1 Then Call 畫線(X1, Y1, X2, Y2, 1, 1, 50, 50, 50)

         Next I

        Call 畫箭頭(1, 0, 0, 200, 0, 0, 0, 250)    '畫x軸

        Call 畫框及寫字(200 + 1 * Xyscale, 0, 15, 15, "x", "ITALIC ", 6, 150, 0, 0, 1)

        Call 畫箭頭(1, 0, 0, 0, 200, 0, 0, 250)   '畫y軸

        Call 畫框及寫字(0, 200 + 1 * Xyscale, 15, 15, "y", "ITALIC ", 6, 150, 0, 0, 1)

        DoEvents     '加此陳述句後電腦在畫圖時,user可以利用點進行其他工作

100 Close

End Sub

下面為利用Excel VBA繪圖之程式所畫出函數f(x,y)=8.*exp(-0.15*(x*x+y*y))

之三維箱匣投影圖形。有關二維函數畫圖之Excel VBA程式設計，其作業方式類似，此部份由讀者自行練習。

下圖為利用Excel VBA建立資料檔後，以VB所畫之3D透視圖形(Din = 30: vDin = 420: Thetain = 30: Phiin = 80: Ssin = 2#)。

7 Excel與VB應用程式互動及整合

7.1 VB呼叫外部執行程式

前面各節我們所討論的大多屬如何在Excel或Excel VBA工作表中建立資料檔，並未曾涉及Excel或Excel VBA與VB間互動及整合應用。在VB應用程式中，可以透過Shell()函數來呼叫外部應用程式如Microsoft Excel、Word，PowerPoint及其他應用執行程式(**.exe延伸檔為”exe”者)，其語法為：

Shell(PathName[,Windowstyle]

下面為在VB程式中呼叫Excel工作表之圖示，其程式碼為：

Dim I As Variant

'請檢查"c:\電腦製圖\三維函數資料檔.xsl"是否存在

I = Shell("C:\Program Files\Microsoft Office\OFFICE11\excel.exe", 3)

End Sub

7.2 VB開啟Excel工作表

利用Shell()函數所能呼叫之外部程式，是一個空白之應用程式，如果需要開啟一個已經存在之工作表(如表4.1)，則必須再用人工方式開啟，使用上好像並不十分方便，所幸VB蠻貼心的提供GetObject()函數與CreateObject()函數可以直接開啟我們需要之工作表。有關CreateObject()函數之語法及應用，讀者請利用VB物件瀏覽(Q)自行查閱。下面我們所披露開啟Excel工作表程式碼，係參考及修正自VB所提供GetObject()函數應用範例者。

Declare Function FindWindow Lib "user32" Alias _

"FindWindowA" (ByVal lpClassName as String, _

               ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _

"SendMessageA" (ByVal hWnd as Long,ByVal wMsg as Long, _

               ByVal wParam as Long, _

               ByVal lParam As Long) As Long

Sub GetExcel()

Dim ExcelWasNotRunning As Boolean   ' 用來標示最後是否要關閉 Microsoft Excel 的旗標。

   Dim FileName_Excel As String

   FileName_Excel = "L:/電腦製圖數學/VB用函數資料檔new.xls"

' 檢查 Microsoft Excel 是否已經在執行。

   On Error Resume Next   ' 將錯誤狀況處理方式指定成「繼續下一行」。

' 以省略第一個引數的方式來呼叫 Getobject 函數，傳回應用程式的執行個體之引用。如果該程式尚未執行，將會產生錯誤。

   Set MyXL = GetObject(, "Excel.Application")

   If Err.Number <> 0 Then ExcelWasNotRunning = True

   Err.Clear   ' 若錯誤發生時，清除 Err 物件。

' 查看 Microsoft Excel。如果 Microsoft Excel 正在執行，

' 將它加入執行中的物件資料表中。

   Call DetectExcel

' 將程式的引用儲存到物件變數中。

   Set MyXL = GetObject(FileName_Excel)

' 利用 Application 屬性將 Microsoft Excel 顯示出來。然後

' 使用 MyXL 物件引用的 Windows 集合物件將工作表視窗顯示出來。

   MyXL.Application.Visible = True

   MyXL.Parent.Windows(1).Visible = True

' 如果 Microsoft Excel 先前未執行，

' 則使用 Application 屬性的 Quit 方法將之關閉。

' 請注意，當您試圖關閉 Microsoft Excel時，

' 標題列會閃爍，並出現一訊息詢問您是否

' 要儲存已載入的工作表檔案。

   If ExcelWasNotRunning = True Then

      MyXL.Application.Quit

   End If

Set MyXL = Nothing   ' 釋放程式與工作表的引用。

End Sub

Sub DetectExcel()

' 該程序檢測並註冊一個執行中的 Excel。

   Const WM_USER = 1024

   Dim hWnd As Long

' 如果 Excel 正在執行，則該 API 呼叫將傳回它的物件代碼。

   hWnd = FindWindow("XLMAIN", 0)

   If hWnd = 0 Then   ' 0 means Excel not running.

      Exit Sub

   Else

   ' Excel 正在執行，因此可以使用 SendMessage API

   ' 函數將其放入執行中的物件資料表。

      SendMessage hWnd, WM_USER + 18, 0, 0

   End If

End Sub

另外一個是不必使用到API程式宣告的簡單程式碼寫法，其內容如下：

Sub CmdOpenExcel_Click()

Dim strFileName As String

On Error GoTo ErrHandler

    Dim xlsApp As Object

    Dim xlsWorkBook As Object

    strFileName = "L:\電腦製圖數學\VB用函數資料檔new.xls" '此檔案必須在指定之硬碟中確實存在

    Set xlsApp = CreateObject("Excel.Application")

    xlsApp.Visible = True

    Set xlsWorkBook = xlsApp.Workbooks.Open(strFileName)   '開啟VB用函數資料檔new.xls工作表

    Exit Sub

ErrHandler:

    MsgBox "開啟VB用函數資料檔new.xls工作表發生錯誤??? " & _

    " 請檢視檔案!!!", vbCritical, "資料檔錯誤"

End Sub

7.2 VB利用Excel圖表精靈

利用VB程式所提供之繪圖函數或方法，是可以編寫程式碼繪製圖表(Chart)，不過其所畫出來之圖表，似乎就沒有Excel的圖表精靈畫的好看及多樣性，必竟製作圖表是Excel擅長之功能之一，另外，Excel有三百多種工作表函數，如能善加利用，對VB程式開發幫助甚大。Excel所提供圖表類別有七十幾種(詳下表)。

在VB程式中，呼叫引用Excel之圖表精靈繪製圖表，其作業方式主要有：

(1)在VB程式或在Excel工作表中利用下拉式清單方塊選取圖表類型。

(2)載入已設計完成之Excel工作表，並將需要繪製圖表之資料檔(含水平軸及垂直軸座標、刻度、標題及圖名等)匯入Excel工作表儲存格或寫入資料檔儲存備用。

(3)點按工作表中資料性質自動分析按鈕，分析匯(或讀)入之資料之筆數及儲存格範圍。

(4)點按工作表中自動插入圖表按鈕利用，Excel的圖表精靈製作圖表。

(5)關閉Excel工作表，匯出圖表至VB圖像方塊。

下面是所使用之設計表單式樣及點按(1)圖表類別查詢按鈕後之畫面。

上述作業方式並非不能改變，讀者可依個人喜愛及需求作適度之修正。有關VB之程式碼設計並不困難，下面提供部份較重要程式的程式碼供讀者參考。

Private Sub ChartPlot(ChartTypeNameIn As String, XaxilNameIn As String, YaxilNameIn As String, ChartcaptionIn As String, _XscaleUnit As String, YscaleUnit As String)

Dim strFileName As String

Dim Ut(100) As String, FF(4, 100) As String, NdataType As Integer, NdataEach As Integer

Dim J As Integer, I As Integer, utMAX As Single, utMIN As Single, ffMAX As Single, ffMIN As Single, utTpt As Single, ffTpt As Single

'On Error GoTo ErrHandler

    Dim xlsApp As Object

    Dim xlsWorkBook As Object, MySheet As Object

    strFileName = "L:\電腦製圖數學\自動繪製圖表與VB之互動final.xls" '此檔案必須在指定之硬碟中確實存在

    Set xlsApp = CreateObject("Excel.Application")

    xlsApp.Visible = True

    Set xlsWorkBook = xlsApp.Workbooks.Open(strFileName)   '開啟VB用函數資料檔new.xls工作表

    Set MySheet = xlsWorkBook.Worksheets(1)

     Call BlendinF(NdataType, NdataEach, Ut(), FF())     '呼叫產生圖表資料之程序

    For I = 1 To 1 'NdataEach    '資料Ut()匯入工作表Cells(7, I)儲存格中

     MySheet.Cells(7, I).Value = Ut(I)

     Next I

     For J = 1 To 1 'NdataType    '資料FF()匯入工作表Cells(J + 7, I)儲存格中

      For I = 1 To NdataEach

      MySheet.Cells(J + 7, I).Value = FF(J, I)

      Next I

    Next J

    utMAX = -9999999#

    utMIN = 9999999#

    For I = 2 To NdataEach    '求Ut()最大最小值

     utTpt = Val(Ut(I))

     If utTpt >= utMAX Then utMAX = utTpt

     If utTpt < utMIN Then utMIN = utTpt

     Next I

    MySheet.Cells(2, 5) = utMAX

    MySheet.Cells(2, 6) = utMIN

    MySheet.Cells(2, 7) = XscaleUnit

    MySheet.Cells(2, 1) = ChartTypeNameIn

    ffMAX = -99999#

    ffMIN = 99999#

    For J = 1 To NdataType   '求FF()最大最小值

    For I = 2 To NdataEach

     ffTpt = Val(FF(J, I))

    MySheet.Cells(J + 7, I) = FF(J, I)

    If ffTpt >= ffMAX Then ffMAX = ffTpt

    If ffTpt < ffMIN Then ffMIN = ffTpt

     Next I

    Next J

    MySheet.Cells(2, 8) = ffMAX   '將資料匯入工作表儲存格等

    MySheet.Cells(2, 9) = ffMIN

    MySheet.Cells(2, 10) = YscaleUnit

    MySheet.Cells(4, 4) = XaxilName

    MySheet.Cells(4, 5) = YaxilName

    MySheet.Cells(4, 7) = ChartCaption

    MySheet.Visible = True

    GoTo 100

    Exit Sub

ErrHandler:

    MsgBox "開啟自動繪製圖表與VB之互動final.xls工作表發生錯誤??? " & _

    " 請檢視檔案!!!", vbCritical, "資料檔錯誤"

100 End Sub

VB程式ChartPlot()將資料匯入活頁簿"L:\電腦製圖數學\自動繪製圖表與VB之互動final.xls”工作表後，其`姐結束如下圖所示。而在Excel工作表中，則安排有(a)資料性質自行分析，及(b)自動插入圖表等二個指令按鈕。

其中各有相關Excel VBA程式碼刊登如下，供讀者參考。

Sub ChartPlot()

' 以下是先利用錄製巨集後,再修改以符合實際需要者

    Dim 資料來源 As String, 圖表類型代碼 As Integer, 圖表類型 As Long

    Dim Xmax As Single, Xmin As Single, Xunit As Single, Ymax As Single, Ymin As Single, Yunit As Single

    Dim XaxilName As String, YaxilName As String, ChartCaption As String

     Sheets("Sheet1").Select

      With Selection.Font

        .Name = "新細明體"

        .Size = 9

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

    End With

     圖表類型代碼 = ActiveSheet.Range("A2")

If 圖表類型代碼 = 0 Then 圖表類型 = xlLine

-

-

-

-

If 圖表類型代碼 = 71 Then 圖表類型 = xlPyramidBarClustered

If 圖表類型代碼 = 72 Then 圖表類型 = xlPyramidBarStacked100

     'If 圖表類型代碼 = 24 Then 圖表類型 = xlXYScatterSmooth

    ActiveSheet.Range("D2") = ActiveSheet.Range("B19")

     ActiveSheet.Range("A1") = "圖表類型"

     ActiveSheet.Range("D1") = "資料來源"

     ActiveSheet.Range("E1") = "X最大值"

     ActiveSheet.Range("F1") = "X最小值"

     ActiveSheet.Range("G1") = "X刻度值"

     ActiveSheet.Range("H1") = "Y最大值"

     ActiveSheet.Range("I1") = "Y最小值"

     ActiveSheet.Range("J1") = "Y刻度值"

     ActiveSheet.Range("D3") = "水平軸標題"

     ActiveSheet.Range("E3") = "垂直軸標題"

     ActiveSheet.Range("G3") = "圖表標題"

     資料來源 = ActiveSheet.Range("D2")

     Xmax = ActiveSheet.Range("E2")

     Xmin = ActiveSheet.Range("F2")

     Xunit = ActiveSheet.Range("G2")

     Ymax = ActiveSheet.Range("H2")

     Ymin = ActiveSheet.Range("I2")

     Yunit = ActiveSheet.Range("J2")

     XaxilName = ActiveSheet.Range("D4")

     YaxilName = ActiveSheet.Range("E4")

     ChartCaption = ActiveSheet.Range("G4")

    ActiveSheet.Range("A5").Select

        Charts.Add

    ActiveChart.ChartType = 圖表類型   '圖表類型

   ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(資料來源), _

     PlotBy:=xlRows    '資料來源

    ActiveChart.Location Where:=xlLocationAsNewSheet

With ActiveChart

         .HasTitle = True

         .ChartTitle.Characters.Text = ChartCaption   ' 曲線標題名稱

        .Axes(xlCategory, xlPrimary).HasTitle = True                  'x軸名稱

        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = XaxilName

'x軸名稱

        .Axes(xlValue, xlPrimary).HasTitle = True                    'y軸名稱

        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = YaxilName

'y軸名稱

        End With

    With ActiveChart.Axes(xlCategory) 'x軸名稱

        .HasMajorGridlines = True     '有主要格線

        .HasMinorGridlines = True     '有次要格線

    End With

    With ActiveChart.Axes(xlValue)  'y軸名稱

        .HasMajorGridlines = True   '有主要格線

        .HasMinorGridlines = False  '無次要格線

    End With

    ActiveChart.Axes(xlCategory).Select 'x軸名稱

    With ActiveChart.Axes(xlCategory)

        .MaximumScale = Xmax   '1         '最大刻度

        .MinimumScale = Xmin   '1         '最小刻度

        .MinorUnitIsAuto = True

        .MajorUnit = Xunit             'y軸刻度單位

        .Crosses = xlAutomatic

        .ReversePlotOrder = False

        .ScaleType = xlLinear

        .DisplayUnit = xlNone

    End With

    With ActiveChart.Axes(xlCategory) 'x軸名稱

        .MinimumScaleIsAuto = True

        .MaximumScale = Xmax  '1          '最大刻度

        .MinorUnitIsAuto = True

        .MajorUnitIsAuto = True

        .Crosses = xlAutomatic

        .ReversePlotOrder = False

        .ScaleType = xlLinear

        .DisplayUnit = xlNone

    End With

    ActiveChart.Axes(xlValue).Select   'y軸名稱

    With ActiveChart.Axes(xlValue) 'y軸刻度單位

        .MaximumScale = Ymax   '1         '最大刻度

        .MinimumScale = Ymin   '1         '最小刻度

        .MinorUnitIsAuto = True

        .MajorUnit = Yunit            'y軸刻度單位

        .Crosses = xlAutomatic

        .ReversePlotOrder = False

        .ScaleType = xlLinear

        .DisplayUnit = xlNone

    End With

    'Worksheets("Chart10").ChartObjects(1) _

.Chart.Export _

   ' Filename:="L：\電腦製圖數學\MyChart.bmp", FilterName:="bmp"

     ActiveChart.ChartArea.Copy

100 End Sub

Private Sub 資料性質()

Dim St_test As String * 20, St_tpt As String * 20, I As Integer, J As Integer, CurU As Range

Sheets("Sheet1").Select

ActiveSheet.Range("A7").Select

Okvalue = MsgBox("您確定選取正確之第1筆資料第1個作用儲存格嗎?", 1, "請確認!!!!")

If (Okvalue = 2) Then

Close

MsgBox "請選取第1筆資料第1個作用儲存格"

GoTo 200

End If

I = 1

Icol = ActiveCell.Column '記錄第1個作用儲存個欄位

Irow = ActiveCell.Row    '記錄第1個作用儲存個列位

St_test = Trim(Cells(Irow, Icol))

MsgBox "ST_TEST=" & St_test

Ndata_zone = 1

For I = 2 To 200

Cells(I, Icol + 1).Select

St_tpt = Trim(ActiveCell)

If (St_test = St_tpt) Then

Ndata_zone = Ndata_zone + 1

If (Ndata_zone = 2) Then Ndata_1set = I - 2

End If

Next I

ActiveSheet.Range("P2") = "資料區?"

ActiveSheet.Range("P3") = Ndata_zone

ActiveSheet.Range("Q2") = "每筆資料有幾欄?"

Cells(Irow, 1).Select

J = 0

Do While Not IsEmpty(ActiveCell) '迴路開始:如果作用儲存格非空白繼續下移一列,否則退出迴路

J = J + 1

ActiveCell.Offset(1, 0).Select '作用儲存格往下移一行

Loop   '迴路終止

Ndata_1set = J

ActiveSheet.Range("Q3") = Ndata_1set

I = 1

Icol = 1

Irow = 7

Cells(Irow, Icol).Select

Do While Not IsEmpty(ActiveCell) '迴路開始:如果作用儲存格非空白繼續下移一列,否則退出迴路

I = I + 1

ActiveCell.Offset(0, 1).Select '作用儲存格往下移一列

Loop   '迴路終止

Ndata_畫圓I = I - 1

Range("R2") = "資料總筆數"

Range("R3") = Ndata_畫圓I

Cells(Irow, Icol).Select

200 End Sub

    下圖分別為利用Excel圖表精靈所繪製之圖表及載入VB圖像方塊後之圖表樣式。