在窗口调整大小事件

时间:2016-10-18 15:39:58

标签: windows vba excel-vba winapi vb6

问题

每当调整主Excel窗口时调用一个过程。

第一次尝试:

Sub Workbook_WindowResize(ByVal Wn As Window)
    Debug.Print Wn.Width & "x" & Wn.Height
End Sub

结果:

每当调整“内部”工作簿窗口的大小时调用子例程,而不是在调整应用程序窗口大小时调用子例程。

第二次尝试

Dim WithEvents App As Application
Private Sub App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
    Debug.Print Wn.Width & "x" & Wn.Height
End Sub

结果:

奇怪的是,同样的事情发生在之前,这确实让我感到惊讶。仅在调整工作簿窗口而不是应用程序窗口时才会发生该事件。

因此我开始考虑使用Windows API。

有许多使用Windows API设置SystemWide键盘和鼠标挂钩的示例。这是一致的:

Public Enum enHookTypes
    WH_CALLWNDPROC = 4
    WH_CALLWNDPROCRET = 12
    WH_CBT = 5
    WH_DEBUG = 9
    WH_FOREGROUNDIDLE = 11
    WH_GETMESSAGE = 3
    WH_HARDWARE = 8
    WH_JOURNALPLAYBACK = 1
    WH_JOURNALRECORD = 0
    WH_MOUSE = 7
    WH_MSGFILTER = (-1)
    WH_SHELL = 10
    WH_SYSMSGFILTER = 6
    WH_KEYBOARD_LL = 13
    WH_MOUSE_LL = 14
    WH_KEYBOARD = 2
 End Enum

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As LongPtr
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

'Ensure that your hook procedure does not interfere with the normal operation of other hook procedures
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Public hndl As Long

Sub HookWindow()
    hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
    Debug.Print hndl & "~~" & GetLastError()
End Sub

Sub unhookWindow()
    ret = UnhookWindowsHookEx(hndl)
    Debug.Print ret
End Sub

Public Sub measureWindow(code As Long, wParam As Long, lParam As Long)
    If code > 0 Then
        Debug.Print ThisWorkbook.Windows(1).Width & "x" & ThisWorkbook.Windows(1).Height
    Else
        ret = CallNextHookEx(measureWindow, code, wParam, lParam)
    End If
End Sub

结果:

如果我替换了WH_CALLWNDPROC

hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
带有WH_KEYBOARD_LL

只要按下一个键,就会调用子程序。同样,如果我用WH_MOUSE_LL替换它,只要移动鼠标或按下鼠标按钮,就会调用子程序。

问题在于,当我尝试将子例程挂钩到WH_CALLWNDPROC时,没有任何事情发生?

为什么?

我仍然不确定,但除了enHookTypesWH_MOUSE_LL之外WH_KEYBOARD_LL中的所有ENUMS都是如此。通过WinAPI文档,我看到你可以使用Kernel32.dll中的GetLastError来获得操作失败原因的一些指示。

到目前为止,我得到的错误数字是(十进制)error 5(对于JOURNAL钩子)和其余的error 1428

最终这也失败了。

2 个答案:

答案 0 :(得分:1)

Application.Windows是在Application中打开的Worbooks的窗口对象的集合。当非最大化窗口更改大小时,将引发WindowResize事件。 Workbook_WindowResize(ByVal Wn As Window)在工作簿对象本身中公开。当非最大化工作簿的窗口改变大小时,Application_WindowResize(ByVal Wb as Workbook,ByVal Wn As Window)事件与Application中的任何/所有工作簿有关。因此,事件传递的参考的差异。它只是第一种情况下的窗口,是工作簿对象中引发事件的工作簿,并且毫无疑问它在哪个窗口(它是"我"工作簿&# 39; s窗口)。它是工作簿和工作簿的窗口,当它在应用程序级别引发时,因为事件与需求识别有关的工作簿:)而且,不,Excel没有" Resize" App窗口本身的事件,您需要转到API。

使用更高版本的Excel版本(超过2010年),每个Excel应用程序窗口都有一个工作簿,工作簿窗口在旧的意义上总是最大化,并且工作簿和应用程序事件都引用相同的工作簿和会像你希望的那样工作。

答案 1 :(得分:0)

解决方案,创建一个计时器事件,每隔几秒钟检查并比较宽度...

Sub my_ONTIME()
    application.OnTime Now + TimeValue("00:00:2"), "my_TIMEREVENT"
End Sub
Sub my_TIMEREVENT()
    If application.Width <> EWIDTHR Then ESCREENRESIZE
    my_ONTIME
End Sub
Sub ESCREENRESIZE()
    Dim EWIDTH As Single
    Dim ESIDE As Single
    Dim EMID As Single
    EWIDTH = application.Width
    EWIDTHR = EWIDTH
    If EWIDTH < 500 Then
        EWIDTH = 500
        application.Width = 500
    End If
    EMID = 80 * 5.41
    ESIDE = ((EWIDTH - EMID) / 2) / 5.41
    Sheet1.Columns("A:A").ColumnWidth = ESIDE
    Sheet1.Columns("C:C").ColumnWidth = ESIDE
End Sub