Te indico lo que tienes que hacer, pero ten en cuenta que mi aportación, en este caso, es prácticamente nula, pues simplemente he hecho una búsqueda y he cogido retazos de código de aquí y de allá. El código que te indicaré tiene los nombres de los autores en forma de comentarios, así que rogaría que si alguien utiliza el código mantenga esos comentarios. Thxs!
1.- Créate un módulo stándar y en él escribes el siguiente código:
Public Const WM_VSCROLL = &H115
Public Const WM_HSCROLL = &H114
Public Const SB_LINEUP = 0
Public Const SB_LINEDOWN = 1
Public Const SB_PAGEUP = 2
Public Const SB_PAGEDOWN = 3
Public Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
' Used in fhWnd() to get a handle on the text box used in mouse wheel code.
Public Declare Function apiGetFocus Lib "User32" _
Alias "GetFocus" _
() As Long
Public Function fhWnd(ctl As Control) As Long
' fhWnd() was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
On Error Resume Next
ctl.SetFocus
If Err Then
fhWnd = 0
Else
fhWnd = apiGetFocus
End If
On Error GoTo 0
End Function
2.- En tu formulario, en el evento "Al mover rueda del mouse", genera este código:
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
' This procedure runs when the mouse wheel is used.
' Copyright © 2014 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
' Proper credit includes mentioning the example by eggieman at
' http://www.access-programmers.co.uk/forums/showthread.php?t=195679
' and the fhWnd() function by Dev Ashish at
' http://access.mvps.org/access/api/api0027.htm.
On Error GoTo Err_Handler
Dim intLinesToScroll As Integer
Dim hwndActiveControl As Long
' Let the mouse wheel scroll in text boxes.
If ActiveControl.Properties.Item("ControlType") = 109 Then
hwndActiveControl = fhWnd(Screen.ActiveControl)
If Count < 0 Then
For intLinesToScroll = 1 To -1 * Count
SendMessage hwndActiveControl, WM_VSCROLL, SB_LINEUP, 0
Next
Else
For intLinesToScroll = 1 To Count
SendMessage hwndActiveControl, WM_VSCROLL, SB_LINEDOWN, 0
Next
End If
End If
Exit_Proc:
On Error Resume Next
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, _
"Form_MouseWheel()"
Resume Exit_Proc
End Sub
Y listos: cuando sitúes el foco en el control deberías poder utilizar la rueda del mouse para desplazarte.
Simplemente tener en cuenta que el módulo hace llamadas a API's de sistemas de 32 bits. Si diera errores por tener un sistema de 64 bits se deberían adaptar esas funciones de API's
Saludos,
Neckkito
http://bit.ly/neckkito /// http://bit.ly/ForoNkSv