程序可以运行，在运行时，会出现假死现象！懂的来~~

[lbszhl]

Option Explicit
Dim RS As ADODB.Recordset
Dim lsRS As ADODB.Recordset

Private Sub Form_Load()
Set RS = New ADODB.Recordset '新建一个recordset
Set lsRS = New ADODB.Recordset
RS.CursorType = adOpenStatic
RS.CursorLocation = adUseClient
RS.LockType = adLockPessimistic
RS.Open "SELECT * FROM jwlist ORDER BY jno ASC", Con
lsRS.CursorType = adOpenStatic
lsRS.CursorLocation = adUseClient
lsRS.LockType = adLockPessimistic
lsRS.Open "SELECT * FROM lsjwlist", Con
For i = 0 To 11
Set Text1(i).DataSource = RS
Text1(i).Locked = True
Next
Text1(0).DataField = "jno"
Text1(1).DataField = "jname1"
Text1(2).DataField = "jxb"
Text1(3).DataField = "jzz"
Text1(4).DataField = "jads1"
Text1(5).DataField = "jname2"
Text1(6).DataField = "jads2"
Text1(7).DataField = "jtbdw"
Text1(8).DataField = "jdate"
Text1(9).DataField = "jxs"
Text1(10).DataField = "jqk"
Text1(11).DataField = "jbz"


总数.Caption = RS.RecordCount
Text3.Text = ""
Text4.Text = ""

now_add = True
now_find = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
RS.MoveFirst
RS.Close
Do While lsRS.EOF = False
lsRS.Delete
lsRS.MoveNext
Loop
lsRS.Close
End Sub

Private Sub oplxr_Click()
Text4.Locked = False
Text4.SetFocus
Text3.Locked = True

Text3.Text = ""

End Sub

Private Sub opname_Click()
Text3.Locked = False
Text3.SetFocus
Text4.Locked = True

Text4.Text = ""

End Sub






Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Index
Case 1
RS.MoveFirst
Case 2
RS.MovePrevious
If RS.BOF Then
RS.MoveFirst
End If
Case 3
RS.MoveNext
If RS.EOF Then
RS.MoveLast
End If
Case 4
RS.MoveLast
Case 5
If now_find Then
Frame2.Visible = False
Frame3.Visible = True
Text3.Text = ""
Text4.Text = ""

opname.Value = False
oplxr.Value = False

For i = 1 To 4
Toolbar1.Buttons(i).Enabled = False
Next
Toolbar1.Buttons(6).Enabled = False
Toolbar1.Buttons(7).Enabled = False
Toolbar1.Buttons(8).Enabled = True
Toolbar1.Buttons(5).Caption = "确定"
Else
If Text3.Locked = False Then
RS.Filter = "jbo LIKE ( '*" & Trim(Text3.Text) & "*')"
ElseIf Text4.Locked = False Then
RS.Filter = "jname1 LIKE ( '*" & Trim(Text4.Text) & "*')"

Else
MsgBox ("请写入查询条件"), vbInformation + vbOKOnly, "信息错误"
Exit Sub
End If
If RS.EOF Then
MsgBox ("无所需查找的资料"), vbInformation + vbOKOnly, "信息错误"
Exit Sub
End If

Frame2.Visible = True
Frame3.Visible = False
For i = 1 To 4
Toolbar1.Buttons(i).Enabled = True
Next
Toolbar1.Buttons(6).Enabled = True
Toolbar1.Buttons(7).Enabled = True
Toolbar1.Buttons(8).Enabled = True
Toolbar1.Buttons(5).Caption = "查询"
Do While lsRS.EOF = False
lsRS.Delete
lsRS.MoveNext
Loop
Do While RS.EOF = False
lsRS.AddNew
For i = 0 To 11
lsRS.Fields(i) = RS.Fields(i)
Next
lsRS.Update
RS.MoveNext
Loop
RS.MoveFirst
End If
now_find = Not now_find
Exit Sub
Case 6
If now_add Then
old = RS.Bookmark
RS.AddNew
Text1(0).SelStart = 1
Text1(0).SelLength = Len(Text1(0).Text)
Toolbar1.Buttons(6).Caption = "确定"
Toolbar1.Buttons(7).Caption = "取消"
For i = 1 To 5
Toolbar1.Buttons(i).Enabled = False
Next
Toolbar1.Buttons(8).Enabled = False
Toolbar1.Buttons(9).Enabled = False
For i = 0 To 11
Text1(i).Locked = False
Next
For i = 0 To 6
Label8(i).Visible = True
Next
Else
If Text1(0).Text = "" Or Text1(1).Text = "" Or Text1(2).Text = "" Or Text1(3).Text = "" Or Text1(4).Text = "" Or Text1(9).Text = "" Or Text1(10).Text = "" Then
MsgBox ("请填写带*号项")
Exit Sub
Else
With RS
.Fields("jno") = Text1(0).Text
.Fields("jname1") = Text1(1).Text
.Fields("jxb") = Text1(2).Text
.Fields("jzz") = Text1(3).Text
.Fields("jads1") = Text1(4).Text
.Fields("jname2") = Text1(5).Text
.Fields("jads2") = Text1(6).Text
.Fields("jtbdw") = Text1(7).Text
.Fields("jdate") = Text1(8).Text
.Fields("jxs") = Text1(9).Text
.Fields("jqk") = Text1(10).Text
.Fields("jbz") = Text1(11).Text

.Update
总数.Caption = .RecordCount
End With
End If
Toolbar1.Buttons(6).Caption = "添加"
Toolbar1.Buttons(7).Caption = "更新"
For i = 1 To 5
Toolbar1.Buttons(i).Enabled = True
Next
Toolbar1.Buttons(8).Enabled = True
Toolbar1.Buttons(9).Enabled = True
For i = 0 To 11
Text1(i).Locked = True
Next
For i = 0 To 6
Label8(i).Visible = False
Next
End If
now_add = Not now_add
Exit Sub
Case 7
If now_add Then
old = RS.Bookmark
For i = 0 To 11
Text1(i).Locked = False
Next
Toolbar1.Buttons(6).Caption = "确定"
Toolbar1.Buttons(7).Caption = "取消"
For i = 1 To 5
Toolbar1.Buttons(i).Enabled = False
Next
For i = 0 To 6
Label8(i).Visible = True
Next
Toolbar1.Buttons(8).Enabled = False
Toolbar1.Buttons(9).Enabled = False
Else
RS.CancelUpdate
RS.Bookmark = old
Toolbar1.Buttons(6).Caption = "添加"
Toolbar1.Buttons(7).Caption = "更新"
For i = 1 To 5
Toolbar1.Buttons(i).Enabled = True
Next
Toolbar1.Buttons(8).Enabled = True
Toolbar1.Buttons(9).Enabled = True
For i = 0 To 11
Text1(i).Locked = True
Next
For i = 0 To 6
Label8(i).Visible = False
Next
End If
now_add = Not now_add
Exit Sub
Case 8

If Not now_find Then
Frame2.Visible = True
Frame3.Visible = False
For i = 1 To 4
Toolbar1.Buttons(i).Enabled = True
Next
Toolbar1.Buttons(6).Enabled = True
Toolbar1.Buttons(7).Enabled = True
Toolbar1.Buttons(8).Enabled = True
Toolbar1.Buttons(5).Caption = "查询"
Else
Unload Me
End If
now_find = True
Exit Sub
End Select
Do While lsRS.EOF = False
lsRS.Delete
lsRS.MoveNext
Loop
lsRS.AddNew
For i = 0 To 11
lsRS.Fields(i) = RS.Fields(i)
Next
lsRS.Update
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Select Case ButtonMenu.Index
Case 1
datrep用户.DataMember = "cmd用户"
datrep用户.Show
Case 2
datrep用户.DataMember = "ls用户"
datrep用户.Show
End Select
End Sub

[lbszhl]

上面的是 frm 代码~~还有个 类模块 是连 ACCESS 的！ 没问提的！

现在的问题出现在 程序运行时~ 有个 导航 按钮`~ 也就是

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) 这个了~

点 CASE1 CASE2 CASE3 CASE4 的时候`~点第一次还可以~连续点~就出现假死状态！

[yinweihong]

好长啊,看不清,既然出现假死情况,试着在一些地方加DoEvents情况
或者
加一个Boolean型变量,当你 Case Load的时候设为false Load完设置为 True,那么你连续点的话就好判断前面点的是否 Load完成,然后才能处理此次Case了

不知道说清楚了没有,呵呵

[popsn]

帮你UP

[wudeqing]

顶了。程序太长子。