Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Cómo ‘matar’ efectivamente un Procedimiento Sub que se ‘resiste’ a cerrarse ¿¿??

Excel - Cómo ‘matar’ efectivamente un Procedimiento Sub que se ‘resiste’ a cerrarse ¿¿??

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Cómo ‘matar’ efectivamente un Procedimiento Sub que se ‘resiste’ a cerrarse ¿¿??

Publicado por Ramón (77 intervenciones) el 25/09/2023 19:09:35
Con el objetivo de habilitar la rueda del ratón en un UserForm cuyo contenido excede el largo de éste, desde los eventos Iniitialize, y QueryClose -que escribiré al final- llamo al código de un módulo VBA cuyo contenido íntegro es el siguiente:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Option Explicit
 ' Based on code from Peter Thornton here:
 ' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
Private Type POINTAPI
    x                               As Long
    y                               As Long
End Type
Private Type MOUSEHOOKSTRUCT
    pt                              As POINTAPI
    hwnd                            As Long
    wHitTestCode                    As Long
    dwExtraInfo                     As Long
End Type
 
Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
 
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As LongPtr, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
 
Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
 
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
 
Private Const WH_MOUSE_LL          As Long = 14
Private Const WM_MOUSEWHEEL        As Long = &H20A
Private Const HC_ACTION            As Long = 0
Private Const GWL_HINSTANCE        As Long = (-6)
 
Private Const WM_KEYDOWN           As Long = &H100
Private Const WM_KEYUP             As Long = &H101
Private Const VK_UP                As Long = &H26
Private Const VK_DOWN              As Long = &H28
Private Const WM_LBUTTONDOWN       As Long = &H201
 
Private Const cSCROLLCHANGE        As Long = 10
 
Private mLngMouseHook              As Long
Private mFormHwnd                  As Long
Private mbHook                     As Boolean
Dim mForm                          As Object
 
 
Sub HookFormScroll(oForm As Object)
    Dim lngAppInst                  As Long
    Dim hwndUnderCursor             As Long
 
    Set mForm = oForm
    hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
    Debug.Print "Form window: " & hwndUnderCursor
    If mFormHwnd <> hwndUnderCursor Then
        UnhookFormScroll
        Debug.Print "Unhook old proc"
        mFormHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
            If mbHook Then Debug.Print "Form hooked"
        End If
    End If
End Sub
 
Sub UnhookFormScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mFormHwnd = 0
        mbHook = False
    End If
End Sub
 
Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
    On Error GoTo errH 'Resume Next
    If (nCode = HC_ACTION) Then
        Debug.Print "action"
        Debug.Print "right window"
        If wParam = WM_MOUSEWHEEL Then
            Debug.Print "mouse scroll"
            MouseProc = True
            If lParam.hwnd > 0 Then
                mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
            Else
                mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
            End If
            Exit Function
        End If
    End If
    MouseProc = CallNextHookEx( _
    mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookFormScroll
End Function

El caso es que una vez ‘visitado’ el Formulario de marras y movida la rueda del ratón -activando con ello el código anterior-, pretendía que una vez cerrado tal formulario, el código activado deje de funcionar, pues he observado que éste sigue de algún modo ejecutándose produciendo efectos extraños no deseados que quisiera no se produzcan, claro.
Con este fin pretendía incluir en el evento Terminate del UserForm alguna suerte de sentencia ‘Nothing’ (¿¿??) que ‘matase’ el procedimiento activado, pero no sé cómo hacerlo.
Rematando el tema:

La llamada desde el evento Initialize la hago con la línea de código: HookFormScroll Me, y la del QueryClose con: UnhookFormScroll.

¿Alguien me echa una mano?

En todo caso gracias de antemano




P.S.- Edito para añadir: Por razones que se me escapan absolutamente los efectos extraños e indeseados a que me refería en mi pregunta han desaparecido por arte de magia. Así que dejo en suspenso mi pregunta... Perdón.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Cómo ‘matar’ efectivamente un Procedimiento Sub que se ‘resiste’ a cerrarse ¿¿??

Publicado por Antoni Masana (2478 intervenciones) el 25/09/2023 20:05:37
No se exactamente que estas haciendo en este código, que si lo entiendo bien, afecta al comportamiento del ratón dentro del formulario.

Bueno en realidad no es dentro del formulario, es el comportamiento del ratón el que has modificado y se sigue comportando igual tengas abierto el formulario o cerrado. Debes restaurar el comportamiento antes de cerrar el formulario.

Te pongo un ejemplo imaginado:
Al mover la rueda del ratón la pantalla se desplaza x líneas y tu lo modificas para que sólo se desplace 1
- Al inicio guardas el valor X en una variable.
- Asignas tu nuevo valor.
- Al cerrar asignas el valor X al ratón.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil

Cómo ‘matar’ efectivamente un Procedimiento Sub que se ‘resiste’ a cerrarse ¿¿??

Publicado por Ramón (77 intervenciones) el 25/09/2023 20:52:14
Gracias, Andoni.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar