1、公用模塊：Option ExplicitPublic Const PI = 3.14159265358979 已知A、B兩點(diǎn)坐標(biāo)計(jì)算方位角，JSFWJ的中文意思是計(jì)算方位角Public Function JSFWJ(xa As Double, ya As Double, xb As Double, yb As Double) As Double 已知A、B兩點(diǎn)坐標(biāo)計(jì)算方位角函數(shù)過程 Dim vx As Double, vy As Double vx = xb - xa: vy = yb - ya 如果A、B兩點(diǎn)坐標(biāo)相同，出現(xiàn)提示對(duì)話框 If vx = 0 And vy = 0 Then Msg

2、Box 您選擇的是同一個(gè)點(diǎn)！, vbOKOnly + vbExclamation, 提示信息 JSFWJ = 999999999# End If 計(jì)算方位角的值 If vx = 0 And vy 0 Then 與y軸正半軸平行 JSFWJ = RadianToAngle(PI / 2#) ElseIf vx = 0 And vy 0 Then 與x軸正半軸平行 JSFWJ = RadianToAngle(0) ElseIf vy = 0 And vx 0 And vy 0 Then 第一象限 JSFWJ = RadianToAngle(Atn(vy / vx) ElseIf vx 0 Then

3、 第二象限 JSFWJ = RadianToAngle(Atn(vy / vx) + PI) ElseIf vx 0 And vy 0 And vy 0 Then 第四象限 JSFWJ = RadianToAngle(Atn(vy / vx) + 2 * PI) End IfEnd Function已知A、B兩點(diǎn)坐標(biāo)計(jì)算距離，JSJLS的中文意思是計(jì)算距離SPublic Function JSJLS(xa As Double, ya As Double, xb As Double, yb As Double) As Double Dim vx As Double, vy As Double v

4、x = xb - xa: vy = yb - ya如果A、B兩點(diǎn)坐標(biāo)相同，出現(xiàn)提示對(duì)話框If vx = 0 And vy = 0 Then MsgBox 您選擇的是同一個(gè)點(diǎn)！, vbOKOnly + vbExclamation, 提示信息 JSJLS = 99999999# End If 計(jì)算距離 JSJLS = Sqr(vx * vx + vy * vy)End Function弧度化角度Public Function RadianToAngle(ByVal alfa As Double) As Double Dim alfa1 As Double, alfa2 As Double alfa

5、 = alfa * 180# / PI alfa = alfa + 0.000000000000001 alfa1 = Fix(alfa) + Fix(alfa - Fix(alfa) * 60#) / 100# alfa2 = (alfa * 60# - Fix(alfa * 60#) * 0.006 RadianToAngle = alfa2 + alfa1End Function窗體模塊：Option Explicit/簡單計(jì)算/Private Sub Form_Load() Me.txt_Xa = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.t

6、xt_方位角 = Me.txt_距離= Me.txt_Xa.SetFocusEnd SubPrivate Sub cmd_數(shù)據(jù)清空_Click() Me.txt_Xa = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.txt_方位角= Me.txt_距離= Me.txt_Xa.SetFocusEnd SubPrivate Sub cmd_退出程序_Click() Dim A As Integer A = MsgBox(確定要退出程序嗎？, vbYesNo + vbQuestion, 溫馨提示) If A = vbNo Then Exit Sub Else

7、 DoCmd.Close End IfEnd SubPrivate Sub cmd_計(jì)算_Click() Dim xa As Double, ya As Double, xb As Double, yb As Double, FWJ As Double, S As Double If IsNull(Me.txt_Xa) Or IsNull(Me.txt_Ya) Or IsNull(Me.txt_Xb) Or IsNull(Me.txt_Yb) Then MsgBox 請(qǐng)輸入完整數(shù)據(jù)！, vbOKCancel + vbInformation, 提示 Me.txt_Xa.SetFocus Me.t

8、xt_方位角 = Me.txt_距離= Else xa = Me.txt_Xa: ya = Me.txt_Ya xb = Me.txt_Xb: yb = Me.txt_Yb If (xb - xa) = 0 And (yb - ya) = 0 Then MsgBox 您選擇的是同一個(gè)點(diǎn)！, vbOKOnly + vbExclamation, 提示信息 Me.txt_方位角 = Me.txt_距離= Else FWJ = JSFWJ(xa, ya, xb, yb) S = JSJLS(xa, ya, xb, yb) Me.txt_距離= Format(S, 0.0000) Me.txt_方位角

9、= Format(FWJ, 0.00000000) End If End IfEnd Sub/批量計(jì)算/打開要進(jìn)行批量計(jì)算的數(shù)據(jù)表計(jì)算前坐標(biāo)數(shù)據(jù)表Private Sub cmd_導(dǎo)入計(jì)算數(shù)據(jù)_Click() DoCmd.RunMacro 導(dǎo)入導(dǎo)出數(shù)據(jù).導(dǎo)入計(jì)算數(shù)據(jù)End Sub Private Sub cmd_批量計(jì)算_Click() Dim JSXH As Integer 定義計(jì)算序號(hào)Dim QDname As String, ZDname As String 第一起點(diǎn)和終點(diǎn)點(diǎn)號(hào)定義起點(diǎn)坐標(biāo)（QDx和QDy）和終點(diǎn)坐標(biāo)（ZDx和ZDy） Dim QDx As Double, QDy As D

10、ouble, ZDx As Double, ZDy As Double Dim Conn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim rs2 As ADODB.Recordset Dim rs3 As ADODB.Recordset Set Conn = CurrentProject.Connection Set rs1 = New ADODB.Recordset Set rs2 = New ADODB.Recordset Set rs3 = New ADODB.Recordset 清空簡單計(jì)算內(nèi)容 Me.txt_Xa = : Me.t

11、xt_Ya = Me.txt_Xb = : Me.txt_Yb = 清空計(jì)算后方位角及距離數(shù)據(jù)表，為計(jì)算后添加數(shù)據(jù)做準(zhǔn)備 rs3.Open select * from 計(jì)算后方位角及距離數(shù)據(jù), Conn, adOpenDynamic, adLockOptimistic rs3.MoveFirst Do While Not rs3.EOF rs3.Delete rs3.Update rs3.MoveNext Loop rs3.Close 打開計(jì)算前坐標(biāo)數(shù)據(jù)表并指向第一條記錄 rs1.Open 計(jì)算前坐標(biāo)數(shù)據(jù), Conn, adOpenDynamic, adLockOptimistic rs1.M

12、oveFirst打開計(jì)算后方位角及距離數(shù)據(jù)表，把計(jì)算后數(shù)據(jù)保存到表中 rs2.Open 計(jì)算后方位角及距離數(shù)據(jù), Conn, adOpenDynamic, adLockOptimistic 讀取表中數(shù)據(jù)，開始計(jì)算 Do While Not rs1.EOF JSXH = rs1!序號(hào) QDname = rs1!起點(diǎn)點(diǎn)號(hào) QDx = rs1!起點(diǎn)x坐標(biāo) QDy = rs1!起點(diǎn)y坐標(biāo) ZDname = rs1!終點(diǎn)點(diǎn)號(hào) ZDx = rs1!終點(diǎn)x坐標(biāo) ZDy = rs1!終點(diǎn)y坐標(biāo) If (ZDx - QDx) = 0 And (ZDy - QDy) = 0 Then MsgBox QDname & 和 & ZDname & 是同一個(gè)點(diǎn), vbOKOnly + vbExclamation, 提示信息 Exit Sub Else rs2.AddNew rs2!序號(hào) = JSXH rs2!名稱 = QDname & & ZDname rs2!方位角 = JSFWJ(QDx, QDy, ZDx, ZDy) rs2!距離= JSJLS(QDx, QDy, ZDx, ZDy) rs2.Update rs1.MoveNext End If Loop rs1.Close rs2.Close 利用宏，把數(shù)據(jù)導(dǎo)出到E