Excel Protected sheet with Timer trigger

[laurent_rio]

Hi,

I created excel sheet with timer trigger, so the sheet will protected after timer reach 00:00. The timer is work and excel is protected after timer reach 00:00 but my issue if i put cursor in edit mode, the timer stop moved and my excel become protected before it reach 0 (since actual timer already pass 0)

How to solve this issues, this is my VBA Code

in Module 1

Sub timer()
interval = Now + TimeValue("00:00:01")
If Range("B1").Value = 0 Then Exit Sub
Range("B1") = Range("B1") - TimeValue("00:00:01")
Application.OnTime interval, "timer"
End Sub

in Module 2

Sub Protectsheets()
Sheets("Sheet1").Protect Password:="Password"
End Sub


Then i call this 2 module when excel started/open, in this workbook

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:35"), "Protectsheets"
Application.OnTime Now, "timer"
End Sub


Can you help where i make my mistakes ?

Thanks.

Rio

 

[Jaafar Tribak]

Hi and welvome to the board.

You cannot run code that updates excel objects when in edit mode .

Take a look at the follwing thread for a workaround and see if you can adapt it to meet your specific requirements:

Problems with running Clock in worksheet cell

Greetings, I've searched the board and this question has been raised before however, unless i overlooked it, no solution has been provided for the two following main problems caused by having a running clock in a worksheet cell : 1-Clock stops updating while excel is in EDIT MODE 2-Excel...

www.mrexcel.com

 

[laurent_rio]

Still a bit confuse, Do you still have the workbook demo from your example

 

[Jaafar Tribak]

Still a bit confuse, Do you still have the workbook demo from your example

The workbook link is dead - I'll post a new workbook example for you but before that if you can explain what you are trying to do in a clearer way.

 

[laurent_rio]

I want to create assessment test in excel worksheet. The sheet will be automatically protected and not editable anymore after timer reach 00:00.
I put the timer in cell B1

Hope its clear

 

[Jaafar Tribak]

Hi,

It Turned out to be more difficult than I initially thought.

Here is a workbook sample


Place this in a Standard Module and run the (Start routine)

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongPtr
    #Else
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr
    #End If
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
  
    Private lStartTime As LongPtr, lTimerCountDown As LongPtr, lTimerProtect As LongPtr
#Else
    
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    
    Private lStartTime As Long, lTimerCountDown As Long, lTimerProtect As Long
#End If

Private lRemainingProtectDelay As Long, lUpdateProtectDelay As Long, lUpdateCountDown As Long
Private bEnteredEdit As Boolean

Private Const lCountDownInterval = 1 'Secs
Private Const lProtectDelay = 60 'Secs

'change constants to suit.
Private Const ASSESSMENT_SHEET = "Sheet1"
Private Const COUNT_DOWN_CELL = "B1"
Private Const SHEET_PASSWORD = "Password"


Public Sub Start()

    If Not TimersAreSet Then
        With Sheets(ASSESSMENT_SHEET)
            .Unprotect Password:=SHEET_PASSWORD
            .Range(COUNT_DOWN_CELL).NumberFormat = "mm:ss"
            .Range(COUNT_DOWN_CELL).Value = 1 / (60 * 24)     ' Start with 1 Minute
        End With
        Call StartTimers
    End If
    
End Sub

Public Sub Finish()
     Call StopTimers
End Sub

Private Sub StartTimers(Optional Dummy As Boolean)

    bEnteredEdit = False
    lUpdateCountDown = 0
    lRemainingProtectDelay = lProtectDelay
    lStartTime = GetTickCount
    
    lTimerCountDown = SetTimer(0, 0, lCountDownInterval * 1000, AddressOf CountDown)
    Call SetProp(Application.hwnd, "TimerCountDown", lTimerCountDown)
    lTimerProtect = SetTimer(0, 0, &H7FFFFFFF, AddressOf Protectsheet)
    Call SetProp(Application.hwnd, "TimerProtect", lTimerProtect)

End Sub

Private Sub StopTimers(Optional Dummy As Boolean)

    Call KillTimer(0, GetProp(Application.hwnd, "TimerProtect"))
    Call KillTimer(0, GetProp(Application.hwnd, "TimerCountDown"))
    Call RemoveProp(Application.hwnd, "TimerProtect")
    Call RemoveProp(Application.hwnd, "TimerCountDown")
    
    lRemainingProtectDelay = 0
    bEnteredEdit = False
    lUpdateCountDown = 0
    lStartTime = 0

End Sub

#If VBA7 Then
Private Sub CountDown(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal nIDEvent As LongPtr, ByVal dwTimer As Long)
    Dim hEdit As LongPtr
#Else
Private Sub CountDown(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Dim hEdit As Long
#End If
    
    On Error Resume Next
    
    If bEnteredEdit = False Then
        If (dwTimer - lStartTime) / 1000 > lRemainingProtectDelay Then
            Call Protectsheet
            Debug.Print "TimeOut"
            Exit Sub
        End If
    End If
    
    hEdit = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
    hEdit = FindWindowEx(hEdit, 0, "EXCEL6", vbNullString)

    If IsWindowVisible(hEdit) Then
        If bEnteredEdit = False Then
            bEnteredEdit = True
        End If
    Else
        lUpdateCountDown = lUpdateCountDown - lCountDownInterval
        lUpdateProtectDelay = lProtectDelay + lUpdateCountDown
        Debug.Print "remaining time : " & vbTab & lUpdateProtectDelay & vbTab & "Secs."
        If bEnteredEdit Then
            bEnteredEdit = False
            lStartTime = GetTickCount
            lRemainingProtectDelay = lUpdateProtectDelay
        End If
    End If
    
    With Sheets(ASSESSMENT_SHEET).Range(COUNT_DOWN_CELL)
        If CDate(.Value) > TimeSerial(0, 0, 0) Then
            .Value = .Value - TimeSerial(0, 0, lCountDownInterval)
        Else
            Call Protectsheet
            Debug.Print "Cell value reached 0."
        End If
    End With

End Sub

Private Sub Protectsheet(Optional Dummy As Boolean)
    Call Sheets(ASSESSMENT_SHEET).Protect(Password:=SHEET_PASSWORD)
    Call StopTimers
    MsgBox "Time Out."
End Sub

Private Function TimersAreSet() As Boolean
    TimersAreSet = CBool(lRemainingProtectDelay)
End Function

Private Sub Auto_Close()
    Call StopTimers
End Sub

 

[laurent_rio]

Hi again,

The timer still stop to count down when it is in edit mode

Thanks

 

[Jaafar Tribak]

Hi again,

The timer still stop to count down when it is in edit mode

Thanks

That's what I thought you wanted .

Indeed, the counter stops when in edit mode but it resumes with the correct countdown value when the user exits edit mode. Hence, the sheet doesn't get protected until the counter reaches 0.

 

[laurent_rio]

Hi,

The test need to run with actual timer even with edit mode, if not people will just put in edit mode to think the answer more than actual timer. So my purpose :
1. The countdown still run even on edit mode
2. the sheets protected after countdown reach 0 (even in edit mode position)

Is it possible ?

 

[Jaafar Tribak]

Hi,

The test need to run with actual timer even with edit mode, if not people will just put in edit mode to think the answer more than actual timer. So my purpose :
1. The countdown still run even on edit mode
2. the sheets protected after countdown reach 0 (even in edit mode position)

Is it possible ?

lol ! You could have explained the above clear explanation in your first post. That would have saved us all the trouble.

As for your request, I am not sure it will be possible but I'll give it a try and and see what I come up with.