sbati 发表于 2006-6-13 00:52:00

菜鸟求助:实现不了功能帮忙看看指点指点

根据 >看的,做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.RecordCount0 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

songzhi 发表于 2006-6-14 22:34:00

有条件的吧!
首先要在引用中添加DAO,其次你要有一个数据库,结构和程序中使用的一样。
页: [1]
查看完整版本: 菜鸟求助:实现不了功能帮忙看看指点指点