[已解决]这个代码怎么改

9910343

这个代码怎么改 Book1.zip (29.74 KB, 下载次数: 17)

2012-8-31 19:59 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

柳如烟

2012-8-31 20:22

Private Sub CommandButton1_Click()
On Error GoTo 10 '当姓名与密码不对应时，会出现错误，转到10语句处理
Dim n As String
Set sh = Sheets("设置")
na = ComboBox1.Text: ps = TextBox1.Text '取得登录窗口中的姓名与密码
If na = "" Or ps = "" Then MsgBox "未输入用户名或密码，不能登录", , "提示": Exit Sub
S = WorksheetFunction.Match(na, sh.[a:a], 0) '查找用户在A列的位置
n = sh.Cells(S, 2) '取出"设置"表中的权限密码，字符型
Sheets("白骨精").Range("d10") = Me.ComboBox1.Value
If n <> ps Then GoTo 10
Call 隐藏表
'检查一下"设置"表的C列及右边各格中的内容，有内容的，说明可以打开内容所指定的工作表
For I = 4 To 255
    b = sh.Cells(S, I).Value
    If b = 1 And sh.Cells(1, I) <> "" Then '单元格为1时，表示有权限打开这个表，就让它显示出来
        Sheets(sh.Cells(1, I).Value).Visible = -1
    End If
Next
Application.Visible = True
Unload UserForm1 '退出窗体
Exit Sub
10:
MsgBox "姓名或密码错误，不能登录", , "提示"
End Sub

跳转到最佳答案楼层

柳如烟

Private Sub CommandButton1_Click()
On Error GoTo 10 '当姓名与密码不对应时，会出现错误，转到10语句处理
Dim n As String
Set sh = Sheets("设置")
na = ComboBox1.Text: ps = TextBox1.Text '取得登录窗口中的姓名与密码
If na = "" Or ps = "" Then MsgBox "未输入用户名或密码，不能登录", , "提示": Exit Sub
S = WorksheetFunction.Match(na, sh.[a:a], 0) '查找用户在A列的位置
n = sh.Cells(S, 2) '取出"设置"表中的权限密码，字符型
Sheets("白骨精").Range("d10") = Me.ComboBox1.Value
If n <> ps Then GoTo 10
Call 隐藏表
'检查一下"设置"表的C列及右边各格中的内容，有内容的，说明可以打开内容所指定的工作表
For I = 4 To 255
    b = sh.Cells(S, I).Value
    If b = 1 And sh.Cells(1, I) <> "" Then '单元格为1时，表示有权限打开这个表，就让它显示出来
        Sheets(sh.Cells(1, I).Value).Visible = -1
    End If
Next
Application.Visible = True
Unload UserForm1 '退出窗体
Exit Sub
10:
MsgBox "姓名或密码错误，不能登录", , "提示"
End Sub