Получить скорость прокрутки мыши [VBA PowerPoint]

Question

Я хочу макрос для PowerPoint VBA, который позволит мне узнать текущую скорость вращения колесика мыши. Когда пользователь не вращает колесо, он возвращает 0, если пользователь вращает, он возвращает значение больше 0, а если пользователь вращает вниз, он возвращает значение меньше 0. Либо это, либо дельта-прокрутка , разница между последней позицией прокрутки / поворотом.

Я пробовал код Excel VBA, который использует WM_MOUSEWHEEL. Я «преобразовал» его в PowerPoint, и он что-то делает, но я не уверен, что означает возвращаемое значение. Он либо возвращает 0, 4, либо очень большое число.

У меня есть следующий код в модуле:

Public Type POINTAPI
    X As Long
    Y As Long
End Type

    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

    Public Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type


    Public Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" _
        (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, _
         ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
        (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, _
         ByVal lParam As LongPtr) As Long
    Public 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
    Public Declare PtrSafe Function WaitMessage Lib "user32" () As Long

    Public XlDeskHwnd As LongPtr
    Public WbkHwnd As LongPtr

Public Const WM_MOUSEWHEEL As Long = &H20A
Public Const PM_REMOVE = &H1

И следующий код находится на слайде:

Option Explicit

Private Sub CommandButton1_Click()
Dim tMSG As MSG
Do
PeekMessage tMSG, WbkHwnd, 0, 0, PM_REMOVE
Label1.Caption = tMSG.wParam
Shapes("db").TextFrame.TextRange.Text = Timer
DoEvents
Loop
End Sub