（求助）倒计时（VBA）

long826121

以下压缩包文件有计时效果，但一旦关闭了文件窗口，计时已停止！对于考试来说，是不符合项！
我想增加以下效果：
该生（200510900001 张雪）一旦登陆进入该生考试卷，此时开始计时，如果时间未到60分钟就关闭窗口，计时扔继续，截止到时间60分钟结束，自动“保存提交”，关闭窗体，当考生重新登陆时，可以进入试卷，但已经锁定，不能修改，密码设置为2008！提示“你的时间已到，不能修改”
（说明：时间未到60分钟就关闭窗口，当考生重新登陆时，可以进入试卷，试卷未被锁定，可以修改）
如何实现，感谢了！感谢各位的帮助！
考试登陆系统.rar (24.96 KB, 下载次数: 99)

2011-8-27 07:41 上传

点击文件名下载附件

Aкon

做个记号学习

吕?布

这个不是已经发过贴了吗？

wdkjs

做个记号学习

long826121

回复 吕?布 的帖子

没有发过贴，你看的只是类似的，其实这个有很多不一样！感谢你！帮帮我撒

吕?布

回复 long826121 的帖子
http://www.excelpx.com/forum.php?mod=viewthread&tid=194944&highlight=

吕?布

http://www.excelpx.com/forum.php ... 4944&highlight=

long826121

回复 吕?布 的帖子

你可以仔细的看看两个题是完全相同的效果吗？况且我上次接受的最佳答案只实现了部分功能！感谢提醒

long826121

回复 吕?布 的帖子

其实倒计时那个问题没完全解决，他只是实现了一个倒计时而已，没有别的功能！我想要的是：今天这个问题的效果，更合理些！感谢你了哈！有时间帮帮我！感谢

zjdh

2个地方需修改：
登录：
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:F" & 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 "登录成功！"
                '*********修改
                If arr(i, 6) = "已考" Then
                    For Each SH In Sheets
                        If InStr(SH.Name, TextXM) Then
                        SH.Protect Password:="2008"
                        MsgBox "考试已结束,不可修改！"
                        Exit For
                        End If
                    Next
                End If
                '**************
                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
                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
End Sub