Question

我希望使用解锁Excel工作表的事件来触发计时器在指定的持续时间后重新锁定工作表。但是，我找不到excel表解锁的事件。

我在此代码中发现了类似的内容。

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



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

Answer 1

我同意@Peh，因为我不知道任何不受保护的事件。不过，您仍有许多选择。最简单的是，如果Worksheet.ProtectContents属性为False，则可以让计时器永久运行并执行代码操作;还有@ Peh的建议，在开发时间方面看起来很有吸引力。但是，另一个想到的答案是利用Unprotect菜单项激活对话窗口的事实。所以你可以创建一个查找该窗口的钩子。

WH_CBT钩子浮现在脑海中，因为钩子注册时不会经常触发。下面的代码显示了如何实现这样的钩子。可能也可以选择“OK”按钮句柄，但我相信它在子窗口枚举中不可见，因此您可能必须使用IAccessibility接口做一些聪明的事情才能找到它。不过，我不确定你真的需要它。

关于代码的几点：首先，我仍然是32位，所以如果你需要的话，你需要调整64位的API定义 - 互联网上应该有很多例子;其次，我不相信可以在回调函数中调用Application.OnTimer，所以一个明显的答案是使用Windows计时器 - 你也会看到几个API;第三，此代码从Windows句柄中捕获事件，因此如果有人通过VBA（或其他程序）取消保护表单，则此解决方案将无法获取它。

所以...在一个模块中（我称之为 modHook ），粘贴以下内容：

Option Explicit

'=======================================================
' HOOK APIs AND CONSTs
'=======================================================
Private Declare Function SetWindowsHookEx _
    Lib "user32" _
    Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long

Private Declare Function CallNextHookEx _
    Lib "user32" ( _
    ByVal hHook As Long, _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Private Declare Function UnhookWindowsHookEx _
    Lib "user32" ( _
    ByVal hHook As Long) As Long

Private Declare Function GetCurrentProcessId _
    Lib "kernel32" () As Long

Private Declare Function GetCurrentThreadId _
    Lib "kernel32" () As Long

Private Declare Function GetWindowTextLength _
    Lib "user32" _
    Alias "GetWindowTextLengthA" ( _
    ByVal HWnd As Long) As Long

Private Declare Function GetWindowText _
    Lib "user32" _
    Alias "GetWindowTextA" ( _
    ByVal HWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long

Private Const WH_CBT = 5
Private Const HCBT_DESTROYWND As Long = 4

'=======================================================
' TIMER APIs
'=======================================================
Public Declare Function SetTimer _
    Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer _
    Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long

'=======================================================
' MODULE-LEVEL VARIABLES
'=======================================================
Private mHookID As Long
Private mTimerID As Long
Private mDuration As Single


Public Function Callback(ByVal lngCode As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As Long) As Long

    'Your CBT callback function.

    Dim txt As String
    Dim retVal As Long

    'Handle the message if it's a window being destroyed.
    If lngCode = HCBT_DESTROYWND Then
        'Get the name of the window.
        retVal = GetWindowTextLength(wParam)
        If retVal > 0 Then
            txt = String(retVal + 1, Chr$(0))
            retVal = GetWindowText(wParam, txt, Len(txt))
            'If it's the Unprotect window, start the timer.
            If txt = "Unprotect Sheet" & Chr$(0) Then
                mTimerID = SetTimer(0&, 0&, 5000&, AddressOf TimerProc)
            End If
        End If
    End If

    'Keep the hook chain.
    CallNextHookEx mHookID, lngCode, wParam, lParam

End Function

Public Sub Attach()
    'Attach the CBT hook
    mHookID = SetWindowsHookEx(WH_CBT, _
                               AddressOf Callback, _
                               0, _
                               GetCurrentThreadId)

End Sub

Public Sub Detach()
    Dim retVal As Long

    'De-register the hook - note critical task!
    retVal = UnhookWindowsHookEx(mHookID)
    If retVal = 1 Then mHookID = 0
End Sub
Private Sub TimerProc(ByVal _
                      HWnd As Long, _
                      ByVal uMsg As Long, _
                      ByVal nIDEvent As Long, _
                      ByVal dwTimer As Long)

    'Your timer callback.

    'First kill the timer to stop it recurring.
    On Error Resume Next
    KillTimer 0&, mTimerID
    On Error GoTo 0

    'Check if the sheet is unprotected.
    'Note: this is needed in case the user hit
    'cancel in the unprotect window.
    If Not Sheet1.ProtectContents Then
        '--> Your timer handling code goes here.
        MsgBox "Hey, you unprotected Sheet1."
    End If
End Sub

您可以将挂钩挂在任何地方。在这个例子中，我在Workbook_Open事件中完成了它：

Private Sub Workbook_Open()
    'Attach the hook to your desired sheet.
    If Me.ActiveSheet Is Sheet1 Then modHook.Attach
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Remove the hook before closing.
    modHook.Detach
End Sub

如果您只对一个特定工作表感兴趣（在此示例中为Sheet1），则在该工作表后面的代码中放置以下内容。当工作表被激活和去激活时，它会注册和取消注册挂钩：

'Use these if you only want the hook for this worksheet.
Private Sub Worksheet_Activate()
    modHook.Attach
End Sub

Private Sub Worksheet_Deactivate()
    modHook.Detach
End Sub

在Excel工作表上创建定时保护事件取消保护

1 个答案: