VB实时错误'340'控件数组元素'3'不存在
PrivateDeclareFunctionGetSystemMenuLib"user32"(ByValhWndAsLong,ByValbRevertAsLong)AsL...
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_REMOVE = &H1000&Private Const SC_COLSE = &HF060
Private Sub Command1_Click()
If Trim(Text1(0).Text) = "" Then
MsgBox "用户名不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) = "" Then
MsgBox "密码不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(1).SetFocus
Exit Sub
End If
If Trim(Text1(2).Text) = "" Then
MsgBox "确认密码不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
MsgBox "确认密码不正确!", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
Dim aa As Integer
aa = 0
If Option1(2).Value = True Then
For i = 0 To 3
If Check1(i).Value = 1 Then
aa = 1
Exit For
End If
Next i
If aa = 0 Then
MsgBox " 普通用户至少要有一项权限!", vbExclamation + vbOKOnly, "警告"
Exit Sub
End If
End If
Dim mrc As ADODB.Recordset
txtSQL = "select * from use where username='" & Trim(Text1(0).Text) & "'"
Set mrc = ExecuteSQL(txtSQL)
If mrc.EOF = False Then
MsgBox " 已存在该用户!", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Text1(0).SelStart = 0
Text1(0).SelLength = Len(Text1(0).Text)
Exit Sub
End If
txtSQL = "select * from use"
Set mrc = ExecuteSQL(txtSQL)
mrc.AddNew
mrc.Fields(0) = Trim(Text1(0).Text)
mrc.Fields(1) = Trim(Text1(1).Text)
For i = 0 To 2
If Option1(i).Value = True Then
Select Case i
Case 0
mrc.Fields("admin") = "y"
Case 1
mrc.Fields("readonly") = "y"
Case 2
For j = 0 To 3
If Check1(j).Value = 1 Then
Select Case j
Case 0
mrc.Fields("qx1") = "y"
Case 1
mrc.Fields("qx2") = "y"
Case 2
mrc.Fields("qx3") = "y"
Case 3
mrc.Fields("qx4") = "y"
End Select
End If
Next j
End Select
End If
Next i
mrc.Update
MsgBox " 用户添加成功!", vbExclamation + vbOKOnly, "警告"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
RemoveMenu GetSystemMenu(frmuser1.hWnd, 0), SC_COLSE, MF_REMOVE
Option1(0).Value = True
End Sub 展开
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_REMOVE = &H1000&Private Const SC_COLSE = &HF060
Private Sub Command1_Click()
If Trim(Text1(0).Text) = "" Then
MsgBox "用户名不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) = "" Then
MsgBox "密码不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(1).SetFocus
Exit Sub
End If
If Trim(Text1(2).Text) = "" Then
MsgBox "确认密码不能为空!", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
MsgBox "确认密码不正确!", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
Dim aa As Integer
aa = 0
If Option1(2).Value = True Then
For i = 0 To 3
If Check1(i).Value = 1 Then
aa = 1
Exit For
End If
Next i
If aa = 0 Then
MsgBox " 普通用户至少要有一项权限!", vbExclamation + vbOKOnly, "警告"
Exit Sub
End If
End If
Dim mrc As ADODB.Recordset
txtSQL = "select * from use where username='" & Trim(Text1(0).Text) & "'"
Set mrc = ExecuteSQL(txtSQL)
If mrc.EOF = False Then
MsgBox " 已存在该用户!", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Text1(0).SelStart = 0
Text1(0).SelLength = Len(Text1(0).Text)
Exit Sub
End If
txtSQL = "select * from use"
Set mrc = ExecuteSQL(txtSQL)
mrc.AddNew
mrc.Fields(0) = Trim(Text1(0).Text)
mrc.Fields(1) = Trim(Text1(1).Text)
For i = 0 To 2
If Option1(i).Value = True Then
Select Case i
Case 0
mrc.Fields("admin") = "y"
Case 1
mrc.Fields("readonly") = "y"
Case 2
For j = 0 To 3
If Check1(j).Value = 1 Then
Select Case j
Case 0
mrc.Fields("qx1") = "y"
Case 1
mrc.Fields("qx2") = "y"
Case 2
mrc.Fields("qx3") = "y"
Case 3
mrc.Fields("qx4") = "y"
End Select
End If
Next j
End Select
End If
Next i
mrc.Update
MsgBox " 用户添加成功!", vbExclamation + vbOKOnly, "警告"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
RemoveMenu GetSystemMenu(frmuser1.hWnd, 0), SC_COLSE, MF_REMOVE
Option1(0).Value = True
End Sub 展开
展开全部
控件数组元素
'item'
不存在(错误
340)
使用无效的索引值引用控件数组的元素。此错误产生的原因及解决方法如下:
已存在的控件数组中没有引用的索引值所指定的控件。
对存在元素的其中之一,把
Index
属性的设置改为所引用的值。或者使用
Load
语句,向数组中添加一个控件,该控件的索引等于此值,然后再引用此索引值。
'item'
不存在(错误
340)
使用无效的索引值引用控件数组的元素。此错误产生的原因及解决方法如下:
已存在的控件数组中没有引用的索引值所指定的控件。
对存在元素的其中之一,把
Index
属性的设置改为所引用的值。或者使用
Load
语句,向数组中添加一个控件,该控件的索引等于此值,然后再引用此索引值。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
If Option1(2).Value = True Then
For i = 0 To 3
If Check1(i).Value = 1 Then
aa = 1
Exit For
End If
Next i
For j = 0 To 3
If Check1(j).Value = 1 Then
检查Option1控件与Check1控件的Index属性看看是否在四个控件(0-3)。
For i = 0 To 3
If Check1(i).Value = 1 Then
aa = 1
Exit For
End If
Next i
For j = 0 To 3
If Check1(j).Value = 1 Then
检查Option1控件与Check1控件的Index属性看看是否在四个控件(0-3)。
追问
怎样看的
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询