求助 datagrid控件 Columns(2) 下标越界问题!!!
' ******************************************************************************'窗体公共变量定义
' ******************************************************************************
Option Explicit
Dim txtSQL As String 'SQL语句
Dim txtTest As String '检验数据库中是否存在记录的SQL语句
Dim rstUser As ADODB.Recordset '用户信息数据集
Dim results As Boolean 'ExcuteSQL函数执行结果
Dim result As Integer
Dim str As String '警告信息的返回值
Private Sub cmdAdd_Click()
If txtIsNull(txtUser) Then '检验输入值不能为空
MsgBox "用户名不能为空！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
If IsOverStringLen(txtUser.Text, 10) Then
MsgBox "用户名不能超过10位！", vbOKOnly + vbExclamation, "警告"
txtUser.SetFocus
txtUser.BackColor = BLUE
Exit Sub
End If
End If
If txtIsNull(txtPassword) Then
MsgBox "为系统安全，请输入密码！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
If IsOverStringLen(txtPassword.Text, 8) Then
MsgBox "密码不能超过8位！", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
txtPassword.BackColor = BLUE
Exit Sub
End If
End If
If cboUser.Text = "" Then
MsgBox "请选择用户类型！", vbOKOnly + vbExclamation, "警告"
cboUser.SetFocus
Exit Sub
Else
If IsOverStringLen(cboUser.Text, 20) Then
MsgBox "用户类型不能超过20位！", vbOKOnly + vbExclamation, "警告"
txtUser.SetFocus
txtUser.BackColor = BLUE
Exit Sub
End If
End If
'检验此用户名是否已经存在
txtTest = "select UserId from tbUser where UserId ='" + Trim(txtUser.Text) + "'"
If DBExist(txtTest) <> 0 Then
MsgBox "用户名重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
txtUser.BackColor = BLUE
Else
txtSQL = "insert into tbUser(UserId,UserPassword,UserKind)"
txtSQL = txtSQL + "values('" + Trim(txtUser.Text) + "','"
txtSQL = txtSQL + Trim(txtPassword.Text) + "','" + Trim(cboUser.Text) + "')"
results = ExecuteSQL(txtSQL, rstUser, True)
MsgBox "添加成功！", vbOKOnly + vbExclamation, "警告"
Call viewDataUser
End If
End Sub
Private Sub cmdDel_Click()
If txtIsNull(txtUser) Then '检验删除记录是否选定
MsgBox "请选择删除的记录！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'提示警告信息
str = MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录")
If str = vbOK Then
txtTest = "select UserId from tbUser where UserId ='" + Trim(txtUser.Text) + "'"
'检验此用户名是否已经存在
If DBExist(txtTest) = 0 Then
MsgBox "无此用户！", vbOKOnly + vbExclamation, "警告"
txtUser.BackColor = BLUE
Else
txtSQL = "delete from tbUser where UserId='" + Trim(txtUser.Text) + "'"
results = ExecuteSQL(txtSQL, rstUser, True)
MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
txtUser.Text = ""
txtPassword.Text = ""
Call viewDataUser
End If
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdModify_Click()
If txtIsNull(txtUser) Then '检验修改记录是否选定
MsgBox "请选择需要修改的记录！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
str = MsgBox("是否修改当前记录？", vbOKCancel, "删除当前记录") '提示警告信息
If str = vbOK Then
txtTest = "select UserId from tbUser where UserId ='" + Trim(txtUser.Text) + "'"
'检验此用户名是否已经存在
If DBExist(txtTest) = 0 Then
MsgBox "无此用户，请添加此用户或重新输入用户名！", vbOKOnly + vbExclamation, "警告"
txtUser.BackColor = BLUE
Else
If IsOverStringLen(txtPassword.Text, 8) Or Trim(txtPassword.Text) = "" Then
MsgBox "密码不能为空且不能超过8位！", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
txtPassword.BackColor = BLUE
Exit Sub
End If
txtSQL = "update tbUser set UserId = '" + Trim(txtUser.Text)
txtSQL = txtSQL + "', UserPassword = '" + Trim(txtPassword.Text)
txtSQL = txtSQL + "',UserKind = '" + Trim(cboUser.Text)
txtSQL = txtSQL + "' where UserId='" + Trim(txtUser.Text) + "'"
results = ExecuteSQL(txtSQL, rstUser, True)
MsgBox " 修改成功！", vbOKOnly + vbExclamation, "警告"
Call viewDataUser
End If
End If
End Sub
Private Sub dgUser_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If result <> 0 Then
txtUser.Text = dgUser.Columns(0).Text
txtPassword.Text = dgUser.Columns(1).Text
cboUser.Text = dgUser.Columns(2).Text
(就是这段,调试的时候显示下标越界,实时错误 9,我已经把Columns默认的2项改成三项了,还是这个问题,整个工程里均有这个问题,请大家帮帮忙,谢谢了....)
End If
End Sub
Private Sub Form_Load()
cboUser.AddItem ("系统管理员")
cboUser.AddItem ("人力资源主管")
cboUser.AddItem ("普通用户")
Call viewDataUser
End Sub
Private Sub txtPassword_Change()
txtPassword.BackColor = WHITE
End Sub
Private Sub txtUser_Change()
txtUser.BackColor = WHITE
End Sub
' ******************************************************************************
'过程名：viewDataUser
'说 明：将用户信息数据在dg中显示
'参 数：无
'返回值：无
' ******************************************************************************
Private Sub viewDataUser()
'检索所有的用户信息
txtSQL = "select UserId as 用户名,UserPassword as 用户密码,UserKind as 用户类型 "
txtSQL = txtSQL + " from tbUser order by UserId"
result = viewData(txtSQL, dgUser)
End Sub
[[it] 本帖最后由 reon 于 2008-5-27 16:01 编辑 [/it]]
[[it] 本帖最后由 reon 于 2008-5-27 16:02 编辑 [/it]]
[[it] 本帖最后由 reon 于 2008-5-27 16:04 编辑 [/it]]
