[已解决](求助)增加功能（VBA）

long826121

打开登录窗口，登录200510900001 张雪，点击“选题登录”，此时只出现随机选题那个学生的试卷，别的表隐藏？如何实现？
感谢了，感谢！
考试登陆系统.rar (24.96 KB, 下载次数: 13)

2011-8-28 08:25 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

zjdh

2011-8-28 08:32

Private Sub CommandButton1_Click()
    Dim arr, j As String, R&, i&, k&
    Static Num1&
    With Sheets("学生考试信息登记表")
        R = .Range("A65536").End(xlUp).Row
        arr = .Range("A2:D" & R)
    End With
    If TextXH.Value = "" Then
        MsgBox "学号不能为空"
        TextXH.SetFocus
        Exit Sub
    End If
    If TextXM.Value = "" Then
        MsgBox "姓名不能为空"
        TextXM.SetFocus
        Exit Sub
    End If
    Y1 = 0
    For i = 1 To UBound(arr)
        If Val(arr(i, 1)) = TextXH.Value Then
            If arr(i, 2) = TextXM.Value Then
                MsgBox "登录成功！"
                Application.Visible = True
                Unload UserForm1
                If arr(i, 4) = "" Then
                    k = Int(4 * Rnd + 3)
                    Sheets("学生考试信息登记表").Cells(i + 1, 4) = Sheets(k).Name
                    Worksheets(k).Copy after:=Worksheets(Sheets.Count)
                    With ActiveSheet
                        .Name = TextXM.Value & "考试试卷" & Sheets(k).Name '加了试卷的分类号
                        .Range("B2") = TextXH.Value
                        .Range("D2") = TextXM.Value
                        .Range("F2") = arr(i, 3)
                    End With
                For Each SH In Sheets
                  If SH.Name <> ActiveSheet.Name Then SH.Visible = 0
                Next
                ElseIf arr(i, 4) <> "" Then
                j = TextXM.Value & "考试试卷" & arr(i, 4)
                Sheets(j).Select
               Call 计时  '调用计时
                End If
            End If
            Exit Sub
        End If
    Next i
    MsgBox "学号或姓名出错，请重新输入！"
    Num1 = Num1 + 1
    If Num1 = 3 Then
       MsgBox "学号或姓名已连续输入3次错误，将退出系统!", 64, "登录窗口温馨提示"
       Application.Quit
       Exit Sub
    End If
    TextXH.SetFocus
    Exit Sub
End Sub

跳转到最佳答案楼层

zjdh

Private Sub CommandButton1_Click()
    Dim arr, j As String, R&, i&, k&
    Static Num1&
    With Sheets("学生考试信息登记表")
        R = .Range("A65536").End(xlUp).Row
        arr = .Range("A2:D" & R)
    End With
    If TextXH.Value = "" Then
        MsgBox "学号不能为空"
        TextXH.SetFocus
        Exit Sub
    End If
    If TextXM.Value = "" Then
        MsgBox "姓名不能为空"
        TextXM.SetFocus
        Exit Sub
    End If
    Y1 = 0
    For i = 1 To UBound(arr)
        If Val(arr(i, 1)) = TextXH.Value Then
            If arr(i, 2) = TextXM.Value Then
                MsgBox "登录成功！"
                Application.Visible = True
                Unload UserForm1
                If arr(i, 4) = "" Then
                    k = Int(4 * Rnd + 3)
                    Sheets("学生考试信息登记表").Cells(i + 1, 4) = Sheets(k).Name
                    Worksheets(k).Copy after:=Worksheets(Sheets.Count)
                    With ActiveSheet
                        .Name = TextXM.Value & "考试试卷" & Sheets(k).Name '加了试卷的分类号
                        .Range("B2") = TextXH.Value
                        .Range("D2") = TextXM.Value
                        .Range("F2") = arr(i, 3)
                    End With
                For Each SH In Sheets
                  If SH.Name <> ActiveSheet.Name Then SH.Visible = 0
                Next
                ElseIf arr(i, 4) <> "" Then
                j = TextXM.Value & "考试试卷" & arr(i, 4)
                Sheets(j).Select
               Call 计时  '调用计时
                End If
            End If
            Exit Sub
        End If
    Next i
    MsgBox "学号或姓名出错，请重新输入！"
    Num1 = Num1 + 1
    If Num1 = 3 Then
       MsgBox "学号或姓名已连续输入3次错误，将退出系统!", 64, "登录窗口温馨提示"
       Application.Quit
       Exit Sub
    End If
    TextXH.SetFocus
    Exit Sub
End Sub

zjdh

这样你在open事件中要添加一段：
For Each SH In Sheets
     SH.Visible = true
Next     

zjdh

注意2楼代码已修改！
调整了语句添加到位置，功能更合理一些。

long826121

回复 zjdh 的帖子

非常感谢！我看见了！你帮我看看，这个能实现不？http://www.excelpx.com/thread-196485-1-1.html

太得闲

绝对不是路过 来学习学习 谢谢