|
|
根据 >看的,做gis辅助,就想实现把图型中各个点的坐标等信息导入数据库,但现在有问题,坐标能捕捉到但好象数据传不到书库库
Option Explicit
Dim daoDb As DAO.Database '数据库对象
Dim daoRs As DAO.Recordset '记录集对象
Dim strPath As String
Private Sub cmdAdd_Click()
On Error GoTo errHandle
'添加一条记录
daoRs.AddNew
ExchangeData True
daoRs.Update
errHandle:
If Err.Number = 3022 Then
MsgBox "首先修改文本框中的数值，然后单击“添加”按钮，完成添加的操作。", vbCritical
End If
Err.Clear
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFirst_Click()
'转到第一条记录
daoRs.MoveFirst
ExchangeData False
End Sub
Private Sub cmdLast_Click()
'转到最后一条记录
daoRs.MoveLast
ExchangeData False
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
If Not daoRs.EOF Then
daoRs.MoveNext
Else
daoRs.MoveLast
End If
ExchangeData False
End Sub
Private Sub cmdDelete_Click()
On Error Resume Next
If MsgBox("删除当前记录？", vbYesNo, "确认删除") = vbYes Then
daoRs.Delete
If daoRs.EOF Then
daoRs.MoveLast
Else
daoRs.MoveNext
End If
End If
ExchangeData False
End Sub
Private Sub cmdPickPt_Click()
Dim ptPick As Variant
Form1.Hide
ptPick = ThisDrawing.Utility.GetPoint(, "指定点")
txtptStX.Text = ptPick(0)
txtptStY.Text = ptPick(1)
Form1.Show
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
If daoRs.BOF Then
daoRs.MoveFirst
Else
daoRs.MovePrevious
End If
ExchangeData False
End Sub
Private Sub cmdSave_Click()
'修改数据库中的元素
daoRs.Edit
ExchangeData True
daoRs.Update
End Sub
Private Sub UserForm_Initialize()
'必须首先获得当前的工程路径
strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName
'连接数据库
Set daoDb = OpenDatabase(Left(strPath, Len(strPath) - 8) & "temp.mdb")
Set daoRs = daoDb.OpenRecordset("temp", 2)
'读取数据库
If daoRs.RecordCount 0 Then
daoRs.MoveFirst
ExchangeData False
End If
End Sub
Private Sub UserForm_Terminate()
'关闭数据库和记录集
daoRs.Close
daoDb.Close
End Sub
Private Sub ExchangeData(ByVal bSave As Boolean)
If bSave Then
daoRs.Fields("工程编号") = txtId.Text
daoRs.Fields("X坐标)") = txtptStX.Text '保存内容仍可使用字段名称或者索引号访问数据库内容
daoRs.Fields("Y坐标") = txtptStY.Text
daoRs.Fields("本点号") = bdian.Text
daoRs.Fields("上点号") = sdian.Text
daoRs.Fields("类型") = lxing.Text
Else
txtId.Text = daoRs.Fields("工程编号") '根据字段名称或者索引均可以访问其内容
txtptStX.Text = daoRs.Fields("X坐标")
txtptStY.Text = daoRs.Fields("Y坐标")
bdian.Text = daoRs.Fields("本点号")
sdian.Text = daoRs.Fields("上点号")
lxing.Text = daoRs.Fields("类型")
End If
End Sub
|
|
置顶卡
