' ******************************************************************************
'窗体公共变量定义
' ******************************************************************************
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]]

斑竹???

补充一下:如果把cboUser.Text = dgUser.Columns(2).Text 删掉,可以正常显示,也能运行,但界面中对应的cboUser.Text选中时就无法显示了,难道RowColChange里什么错误了?请教...!!!!