教你如何通過Excel VBA編寫測量坐標計算程序

1、教你如何通過Excel VBA編寫測量坐標計算程序  發(fā)布日期：2013-01-11  來源：網(wǎng)絡(luò)  作者：未知  瀏覽次數(shù)：1704摘  要：認識VBA、理解VBA，并利用Office Excel VBA編寫測量坐標計算程序。關(guān)鍵詞：Excel VBA 程序 坐標 編寫了解：VBA是什么？簡單的說就是一種自動化語言，它可以使常用的程序自動化,可以創(chuàng)建自定義的解決方案。可以用Excel的宏語言來使Excel自動化運行等Microsoft

2、讓它開發(fā)出來的應(yīng)用程序共享一種通用的自動化語言Visual Basic For Application(VBA)，可以認為VBA是非常流行的應(yīng)用程序開發(fā)語言Visual Basic的子集，事實上VBA是VB應(yīng)用程序的版本，盡管存在有些不同VBA和VB在結(jié)構(gòu)上仍然十分相似。如果你已經(jīng)了解VB會發(fā)現(xiàn)學(xué)習(xí)VBA非?？臁Ｏ鄳?yīng)的學(xué)完VBA會給學(xué)習(xí)VB打下堅實的基礎(chǔ)。理由：選擇Excel VBA編程的理由是因為它的計算功能非常強大，是現(xiàn)今任何編程計算器無法逾越的。它運用范圍廣，計算速度快，計算精度高，合理化顯示等?；蛟S很多測量人員對Excel V

3、BA還有些陌生，主要是大家寄托于計算器、電腦、手機PDA等系列軟件使用。Excel VBA對于大多數(shù)測量人員而沒有系統(tǒng)學(xué)過計算機語言程序設(shè)計的人群來講有一定含糊，不過只要有基本數(shù)學(xué)知識、測量常識和邏輯理解的人，都能通過Excel VBA編寫設(shè)計出稱心如意的測量程序。目標：基于Excel VBA的測量坐標計算程序的設(shè)計目標是將繁瑣計算過程轉(zhuǎn)入到計算機中，利用程序語言的重復(fù)性原理，在計算機中可將坐標計算得出更精確的結(jié)果，使坐標計算更加可靠。最終目標是讓用戶可以通過Excel VBA自行完成坐標計算程序設(shè)計。認識：學(xué)習(xí)VBA到底需要什么基礎(chǔ)和了解些什么？學(xué)習(xí)V

4、BA需要認識英文字母、一般的單詞（如：函數(shù)所用的過程）、數(shù)學(xué)基礎(chǔ)知識、測量常識、邏輯性思維即可。在VBA中需要了解VBA的過程、變量、屬性、方法、事件、語句等。Excel VBA程序可以分為“錄制宏、自定義函數(shù)”，由于錄制宏編寫計算類程序它限制了計算涵式過程，而無法達到自定義數(shù)據(jù)直接運算的目的，所以大家可以通過按鈕式點擊進行自定義函數(shù)過程（還可以通過窗體定義過程）。基本常識：   1、類型：常用類型分為Integer（整型）、Single (單精度型)、Double (雙精度型)、String（字符串型）、Variant(數(shù)字)、Variant

5、(字符)。   2、變量：Dim 變量名 As 數(shù)據(jù)類型。例：Dim A As Double定義變量除了可以使用Dim語句外，比較常的還有：static語句，Private語句，Public語句。   3、常量：Const 常量名 As 數(shù)據(jù)類型  常量的值。例：Const PI =3.1415926535898常量聲明后不可對它再進行賦值。   4、If語句：If  邏輯表達式

6、0;Then           If Q<0 Then              語句塊1                 Q=-1Else 

7、                    Else             語句塊2               

8、0; Q=1        End If                   End If   5、Do循環(huán)語句：Do Wihle 循環(huán)條件         Do

9、0;While Cells(j, 1) <> Empty          語句塊1            X = N + (Cells(j, 1) - D) * Cos(F)     E

10、xit Do               Y = E + (Cells(j, 1) - D) * Sin(F)          語句塊2         &#

11、160;      j = j + 1      Loop                   Loop   6、調(diào)用單元格數(shù)值：With Sheets("單元格名稱")  Wit

12、h Sheets("坐標計算")       N = .Cells(行, 列)         N = .Cells(3, 2)       E = .Cells(行, 列)      &#

13、160;  E = .Cells(4, 2)        D = .Cells(行, 列)         D = .Cells(5, 2)       F = .Cells(行, 列)  

14、0;      F = .Cells(6, 2)     End With                   End With說明：這里的.Cells(行, 列)表示調(diào)用Sheets("坐標計算")單元格中指定數(shù)值。&

15、#160;  7、MsgBox事件語句：Private Sub Workbook_Open() Private Sub Workbook_Open()    MsgBox "提示語句"           MsgBox "歡迎使用直線坐標計算程序！"End Sub    

16、0;                End Sub   主題：通過以上認識相信大家對VBA編程稍有認識與了解，現(xiàn)在將進行測量坐標計算程序設(shè)計。給大家講解的是“直線坐標中樁計算”的程序如何編寫與運算。   思路：根據(jù)單元格輸入的已知數(shù)據(jù)并由With過程調(diào)用，建立Do循環(huán)計算模式自動填充待求點單元格坐標。   準備：本表需將安全級別設(shè)置為“低”，否則運行時點擊計算按鈕沒有

17、反映。     Office Excel 設(shè)置方法如下：     Excel 2003版：工具>>>宏>>>安全性>>>選擇較低的安全級別>>>重新打開文件即可運行。     Excel 2007版：Office按鈕>>>Excel選項>>>信任中心>>>信任中心設(shè)置>>>宏設(shè)置>>>啟用所有宏。 

18、60;版本：程序測試演示版本  Microsoft Office Excel 2003直線坐標計算原理：如下圖所示，已知直線的起點坐標 、起點切線方位角ao、直線長度L。 直線的止點坐標、止點方位角az計算如下： 已知計算數(shù)據(jù)：輸入直線要素起點坐標xo3378605.445起點坐標yo453648.704起點樁號O7586.707計算方位角ao98.565562程序操作步驟：1、設(shè)置表格框架（可以根據(jù)自己的要求設(shè)計），圖示如下： 2、在菜單欄上面點擊右鍵彈出下拉式對話框選中“Visual Basic”。 3、調(diào)用后的Visu

19、al Basic菜單欄顯示如下。 4、插入命令按鈕（按鈕主要用于鼠標點擊時觸發(fā)函數(shù)運行）。 5、插入命令按鈕后樣式，在上面點擊右鍵命令按鈕 對象編輯輸入“坐標計算”名稱（可以根據(jù)自己要求輸入）。同樣方法添加“數(shù)據(jù)清除”按鈕。 6、在“坐標計算”按鈕上面點擊右鍵查看代碼，即可進入代碼編輯區(qū)域。同樣方法編輯“數(shù)據(jù)清除”按鈕代碼。 7、代碼輸入?yún)^(qū)域，在藍色線條位置粘貼“VBA主要源碼”代碼然后點擊左上角Excel圖標即可返回Excel電子表格界面。（這里還可以在VBAProject上面點擊右鍵插入模塊將代碼粘貼到模塊中通過路徑指引，但是在這

20、里就直接將代碼粘貼在按鈕內(nèi)部減少了添加模塊的繁瑣）。  VBA主要源碼：    Option Explicit '顯式聲明模塊中的所有變量      Private Sub CommandButton1_Click()'按鈕下粘貼以下代碼：Dim j As Integer '           

21、0;                                                 

22、0;                  Dim Ai, Bi, Ci, Di, Ei, Fi, Gi, Hi As Double '              &

23、#160;                                       Dim N, E, D, X, Y, F As

24、60;Double '                                              

25、0;                     定義變量Const Pi = 3.14159265358979 '                   &

26、#160;                                                 &

27、#160; With Sheets("坐標計算")    If Trim(.Cells(3, 2) = "" Then MsgBox "請輸入“起點坐標X”！", vbInformation, "提示": Exit Sub '         

28、;If Trim(.Cells(4, 2) = "" Then MsgBox "請輸入“起點坐標Y”！", vbInformation, "提示": Exit Sub '           If Trim(.Cells(5, 2) = ""

29、 Then MsgBox "請輸入“起點樁號K”！", vbInformation, "提示": Exit Sub '       檢測數(shù)據(jù)    If Trim(.Cells(6, 2) = "" Then MsgBox "請輸入“起點方位角F”！"

30、, vbInformation, "提示": Exit Sub '           N = .Cells(3, 2) '                    

31、           E = .Cells(4, 2) '                                

32、  D = .Cells(5, 2) '                          調(diào)用已知數(shù)據(jù)        F = .Cells(6, 2) 

33、;'                                Gi = Int(.Cells(5, 2) + 10) / 10) * 10 ' &#

34、160;       Hi = .Cells(5, 2) + .Cells(7, 2) '                  Fi = Abs(F) '       

35、;                                Ai = Int(Fi) '            &#

36、160;                         Bi = (Fi - Ai) * 100 '              &

37、#160;               Bi = Int(Bi) '                            

38、0;         Ci = (Fi - Ai) * 10000 - 100 * Bi '         六十進制轉(zhuǎn)換為十進制        Di = Bi + Ci 

39、/ 60 '                                 Ei = Ai + Di / 60 '    

40、                             If F < 0 Then '             &

41、#160;                         F = -Ei '                   

42、60;                     Else '                          

43、                      F = Ei '                       

44、60;                  End If '                            

45、;              F = F / 180 * Pi    End With    j = 9  Do While Cells(j, 1) <> Empty ' 

46、0;                      X = N + (Cells(j, 1) - D) * Cos(F) '            

47、0;   Y = E + (Cells(j, 1) - D) * Sin(F) '        坐標計算核心        Cells(j, 2) = Round(X, 3) '     &#

48、160;                   Cells(j, 3) = Round(Y, 3) '                     

49、 j = j + 1 '                                         Loop

50、0;'                                         End Sub '    

51、                                     Private Sub CommandButton2_Click()'按鈕下粘貼以下代碼：