ich möchte per Mausrad ein Datum in einer Textbox (alternativ ginge auch ein Label) um den Wert 1 erhöhen bzw. senken.
Unten stehendes Makro funktioniert soweit fast, jedoch nur, wenn ich mit der Maus im Titelbereich der Userform bin. HIer funktioniert es wunderbar.
Bewege ich die Maus innerhalb der Userform bzw. auch die Textbox reagiert das Makro nur dann, wenn ich zusätzlich das Mausrad gedrückt halte und diese
bewege.
Was muss ich ändern, damit das Makro auch dann funktioniert, wenn ich mit der Maus innerhalb der Userform oder auch innerhalb der Textbox) bin.
Gruß
Chris
Option Explicit
Private Sub UserForm_Activate()
Call MouseWheelHook(Me)
TextBox1.Value = Date
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call MouseWheelUnHook
End Sub
Private Sub UserForm_Deactivate()
Call MouseWheelUnHook
End Sub
Public Sub MouseWheel(ByVal pvlngRotation As Long)
If pvlngRotation > 0 Then
TextBox1.Value = Format(DateSerial(Year(TextBox1.Value), Month(TextBox1.Value), _
Day(TextBox1.Value) + 1), "DD.MM.YYYY")
Else
TextBox1.Value = Format(DateSerial(Year(TextBox1.Value), Month(TextBox1.Value), _
Day(TextBox1.Value) - 1), "DD.MM.YYYY")
End If
End Sub
Option Explicit
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal Wparam As Long, _
ByVal Lparam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const GC_CLASSNAMEUSERFORM = "ThunderDFrame"
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private llngHwnd As Long
Private llngProc As Long
Private lobjForm As Object
Private Function WindowProc( _
ByVal pvlngHwnd As Long, _
ByVal pvlngMsg As Long, _
ByVal pvlngWParam As Long, _
ByVal pvlngLParam As Long) As Long
If pvlngMsg = WM_MOUSEWHEEL Then _
Call lobjForm.MouseWheel(pvlngWParam / 65536)
WindowProc = CallWindowProc(llngProc, _
pvlngHwnd, pvlngMsg, pvlngWParam, pvlngLParam)
End Function
Public Sub MouseWheelHook( _
ByRef probjForm As Object)
Set lobjForm = probjForm
llngHwnd = FindWindow(GC_CLASSNAMEUSERFORM, lobjForm.Caption)
llngProc = SetWindowLong(llngHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub MouseWheelUnHook()
Call SetWindowLong(llngHwnd, GWL_WNDPROC, llngProc)
Set lobjForm = Nothing
End Sub