|
|
本人最近想编一个小程序,用来统计DWG中的零件数据,程序如下,已能运行,但不知道为什么不能录入英文,有哪位大侠能帮忙指导一下,运界面如附件:
Option Explicit
Dim adoCon As Connection '连接对象
Dim adoRs As Recordset '记录集对象
Dim strPath As String
Private Sub cmdAdd_Click()
Dim control As control
For Each control In Form1.Controls
If TypeOf control Is TextBox Then
If control.Text = "" Then
MsgBox "参数不能为空，请重新输入！", vbCritical
Exit Sub
End If
End If
Next
On Error GoTo errHandle
'添加新的记录
With adoRs
.AddNew
.Fields(0) = txtId.Text
.Fields(1) = txtptStX.Text
.Fields(2) = txtptStY.Text
.Fields(3) = 0
.Fields(4) = txtptEnX.Text
.Fields(5) = txtptEnY.Text
.Fields(6) = 0
.Update
End With
Exit Sub
errHandle:
If Err.Number = -2147467259 Then
MsgBox "首先修改文本框中的数值，然后单击“添加”按钮，完成添加的操作。", vbCritical
End If
Err.Clear
'由于添加数据失败，不能更新数据库，故取消更新
adoRs.CancelUpdate
End Sub
Private Sub cmdDelete_Click()
On Error Resume Next
If MsgBox("删除当前记录？", vbYesNo, "确认删除") = vbYes Then
adoRs.Delete adAffectCurrent
If adoRs.EOF Then
adoRs.MoveLast
Else
adoRs.MoveNext
End If
End If
ExchangeData False
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFirst_Click()
adoRs.MoveFirst
ExchangeData False
End Sub
Private Sub cmdLast_Click()
adoRs.MoveLast
ExchangeData False
End Sub
Private Sub cmdModify_Click()
ExchangeData True
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
'如果已经到达末尾
If adoRs.EOF Then
adoRs.MoveLast
Else
adoRs.MoveNext
End If
ExchangeData False
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
If adoRs.BOF Then
adoRs.MoveFirst
Else
adoRs.MovePrevious
End If
ExchangeData False
End Sub
Private Sub UserForm_Initialize()
'必须首先获得当前的工程路径
strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName
'连接数据库
Set adoCon = New Connection
adoCon.CursorLocation = adUseClient
adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
Left(strPath, Len(strPath) - 8) & "lineData.mdb;"
'打开记录集
Set adoRs = New Recordset
adoRs.Open "ptStEn", adoCon, adOpenDynamic, adLockOptimistic
If adoRs.RecordCount > 0 Then
adoRs.MoveLast
adoRs.MoveFirst
ExchangeData False
End If
End Sub
Private Sub UserForm_Terminate()
'关闭连接和记录集
adoRs.Close
adoCon.Close
End Sub
'bSave参数取True，表示将文本框中的内容保存到数据库中；取False表示读取数据库的内容
Private Sub ExchangeData(ByVal bSave As Boolean)
If bSave Then
adoRs.Fields(0) = txtId.Text
adoRs.Fields("ptst(x)") = txtptStX.Text '保存内容仍可使用字段名称或者索引号访问数据库内容
adoRs.Fields("ptst(y)") = txtptStY.Text
adoRs.Fields(4) = txtptEnX.Text
adoRs.Fields(5) = txtptEnY.Text
Else
txtId.Text = adoRs.Fields("ObjectID") '根据字段名称或者索引均可以访问其内容
txtptStX.Text = adoRs.Fields(1)
txtptStY.Text = adoRs.Fields(2)
txtptEnX.Text = adoRs.Fields(4)
txtptEnY.Text = adoRs.Fields(5)
End If
End Sub |
|
置顶卡
