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