Anzeige
Archiv - Navigation
1864to1868
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datum per Mausrad ändern

Datum per Mausrad ändern
17.01.2022 12:42:47
Chris
Hallo Forum,
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

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datum per Mausrad ändern
17.01.2022 15:57:24
volti
Hallo Chris,
der Userformbereich und die Textbox sind Kinder der Userform. Um auch hier das Mausrad abfangen zu können, müsste man auch diese über eine eigene Prozedur umleiten.
Wenn es Dir reicht, dass nur im Userformbereich und in den Controls das Mausrad abgefangen wird und nicht mehr im Caption, könntest Du folgende Änderungen versuchen.
1. Aufnahme der zusätzlichen Declare
2. Änderung der Sub wie gezeigt
Hierbei wird zusätzlich das Handle des Userformbereichs ermittelt und damit die entsprechende Prozedur gehookt.
Leider kann ich das nicht testen, da ich 64-Bit-Office habe und Du wohl noch mit VBA6 unterwegs bist.
Probiere es halt mal aus.
Code:

[Cc]

Private Declare Function FindWindowExA Lib "user32" ( _ ByVal hWnd1 As Long, ByVal hWnd2 As Long, _ ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public Sub MouseWheelHook( _ ByRef probjForm As Object) Set lobjForm = probjForm Dim llnghWndPar As Long llnghWndPar = FindWindow(GC_CLASSNAMEUSERFORM, lobjForm.Caption) llngHwnd = FindWindowExA(llnghWndPar, 0, "F3 Server cec30000", vbNullString) llngProc = SetWindowLong(llngHwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Datum per Mausrad ändern
17.01.2022 16:43:22
Chris
Hallo Karl Heinz,
danke für deine Antwort. Leider tut sich gar nichts.
Ist Stand: userform, Textbox, darin ein Datum. Egal wie /wo ich die Maus bewege, keine Änderung.
Noch eine Ideee?
Gruß
Chris
AW: Datum per Mausrad ändern
17.01.2022 16:54:01
volti
Das ist die Idee, Chris...
ggf. mal Deine Datei hier einstellen, da kann ich dann auch mal probieren
Gruß Karl-Heinz
AW: Datum per Mausrad ändern
17.01.2022 18:34:40
volti
Hallo Chris,
leider musste ich feststellen, dass meine Methode doch nicht sicher funktioniert.
Grund ist, dass ich zum Ermitteln des Kinderfensters die entsprechende Klasse verwendet hatte. Jetzt musste ich feststellen, dass sie bei jeder Neuöffnung der Datei anders ist. War mir bisher nicht bekannt.
Aber ich habe schon die nächste Idee und melde mich wieder.
Gruß
Karl-Heinz
Anzeige
AW: Datum per Mausrad ändern
17.01.2022 20:13:43
volti
Hallo Chris,
teste mal den Code in der anliegenden Datei...
Bei mir läuft es jetzt sowohl mit dem Innenraum wie auch mit dem Caption.
MW.xlsm
Gruß Karl-Heinz
Was muss mann eigentlich...
17.01.2022 21:26:40
{Boris}
Hi Karl-Heinz,
...rauchen, um solche Lösungen zu entwickeln? ;-))
RESPEKT!!!
VG, Boris
AW: Was muss mann eigentlich...
18.01.2022 08:58:34
volti
Hi Boris,
vielen Dank...
Das Rauchen zur Förderung der IT-Lösungsfindung habe ich vor langer Zeit schon aufgegeben. Jetzt ist es nur noch etwas Erfahrung. 🐱
Gruß KH
AW: Was muss mann eigentlich...
18.01.2022 10:24:34
Chris
Hallo KH,
das makro funktioneirt prima. Lege ich einen Frame auf deinen UF, ändert sich das Datum nur, wenn ich innerhalb des Frames1 bin. Lege ich weitere Frames auf die UF, ist es immer der Frame1. Wo genau steht dies im Code? Kann man dies auf weitere Frames ausdehnen oder aber einen bestimmten Frame definieren wonach sich das Datum bei Betätigung des Mausrades ändern soll?
Ansonsten top Lösung.
Chris
Anzeige
Update zur Mausradverarbeitung
18.01.2022 15:35:52
volti
Hallo Chris,
die vorliegende Lösung basiert darauf, dass die Windows-Meldungen eines Fensters umgeleitet werden in eine eigene Prozedur, um dort Aktivitäten abfangen zu können.
Das war zunächst für das Fenster Userform und die Aktivität Mausradbewegung implementiert.
Ich hatte dann das ganze erweitert mit einer weiteren Prozedur für die Kinderfenster, es gab nur eines, den Userforminnenraum.
Da Du jetzt weitere Kinderfenster hinzugefügt hast, funktioniert das nur für das (zufällig) letzte Kind, hier Frame1.
In der nachfolgenden Lösung habe ich jetzt alle Kinder (derzeit max. 9) über eine Prozedur geleitet. Immer eine weitere Extra-Prozedur zu programmieren, erschien mir jetzt zu aufwändig.
Probiere mal aus, ob es jetzt in Deinem Sinne funktioniert.
Wenn Du nur bestimmte Kinder (z.B. Frames) mit dem Mousewheel belegen willst, musst Du die entsprechenden Kinder rausfischen und unbehandelt lassen.
Da die Frames aber keinen Text haben und immer die gleiche Klasse verwenden, ist die Idenfizierung schwierig. Wenn sie immer in der gleichen Reihenfolge kommen, kann man sie abzählen.
Normalerweise würde man die Massenabarbeitung gleichartiger Objekte über die Klassenprogrammierung machen, oder über die Mousemovefunktion der Controls temporäre Hooks einrichten.
Dann kann man auch gezielt nur bestimmte Objekte mit der gewünschten Funktionalität belegen.
Sieh Dir hierzu das Beispiel von Planlos hier im Beitrag, da wurde das so gemacht.
MF.xlsm
Zur Schnellansicht:
Code:

[Cc][+][-]

Private Declare PtrSafe Function CallWindowProcA Lib "user32" ( _ ByVal lpPrevWndFunc As LongPtr, _ ByVal hWnd As LongPtr, ByVal Msg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr #If Win64 Then Private Declare PtrSafe Function SetWindowLongA Lib "user32" _ Alias "SetWindowLongPtrA" ( _ ByVal hWnd As LongPtr, ByVal nIndex As Long, _ ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare PtrSafe Function SetWindowLongA Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal nIndex As Long, _ ByVal dwNewLong As LongPtr) As LongPtr #End If Private Declare PtrSafe Function FindWindowA Lib "user32" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long Private Const GWL_WNDPROC = -4 Private Const WM_MOUSEWHEEL = &H20A ' Mausradmeldung Dim giNr As Integer, i As Integer Dim ghWnd(9) As LongPtr, glpOldProc(9) As LongPtr Sub MouseWheel(ByVal iRotation As Long) ' Action bei Mausradbewegung ' Hier Datum in Textbox ändern With UserForm1.TextBox1 .Value = Format(DateSerial(Year(.Value), Month(.Value), _ Day(.Value) + IIf(iRotation = 120, 1, -1)), "DD.MM.YYYY") End With End Sub Private Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr ' Mausradbewegung verarbeiten, andere Messages an alte Prozedur weiterleiten If uMsg = WM_MOUSEWHEEL Then Call MouseWheel(wParam / 65536) For i = 0 To 9 If hWnd = ghWnd(i) Then WindowProc = CallWindowProcA(glpOldProc(i), ghWnd(i), uMsg, wParam, lParam) Exit For End If Next i End Function Public Function EnumProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long ' Handle des Kinderfensters ermitteln und hooken ghWnd(giNr) = hWnd glpOldProc(giNr) = SetWindowLongA(hWnd, GWL_WNDPROC, AddressOf WindowProc) giNr = giNr + 1 EnumProc = 1 End Function Public Sub MouseWheelHook(sCaption As String) ' Zeiger auf neue Prozedur legen, alte Prozedur sichern ' Userform hooken ghWnd(0) = FindWindowA("ThunderDFrame", sCaption) ' Handle der Userform ermitteln If ghWnd(0) <> 0 Then _ glpOldProc(0) = SetWindowLongA(ghWnd(0), GWL_WNDPROC, AddressOf WindowProc) ' Kinder der Userform hooken giNr = 1 EnumChildWindows ghWnd(0), AddressOf EnumProc, 0 End Sub Public Sub MouseWheelUnHook() ' Zeiger auf alte Prozedur(en) wiederherstellen For i = 0 To 9 If ghWnd(i) <> 0 Then Call SetWindowLongA(ghWnd(i), GWL_WNDPROC, glpOldProc(i)) ghWnd(i) = 0 End If Next i End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Update zur Mausradverarbeitung
19.01.2022 10:26:30
Chris
Hallo KH,
danke für deine Erklärungen. Nun ist es perfekt.
Gibt es gute Links bzw. Literatur, mit denen man dies erlernen kann? Kannst du etwas empfehlen?
Gruß
Chris
AW: Update zur Mausradverarbeitung
19.01.2022 11:32:42
volti
Hi Chris,
wenn Du die API meinst, kann ich leider nichts empfehlen.
Ich habe mir das anhand des "Programming Windows"-Buches von Charles Petzold für Win3.1 und Win95 u.a. anhand externer EXE-Programme angeeignet.
Du siehst, das ist schon lange her und seit Jahren nutze ich nur noch Google...😉
Gruß KH
AW: Update zur Mausradverarbeitung
19.01.2022 14:21:29
Chris
Alles klar, Danke für die Info. Sicherlich gibt es Neuauflagen o. Ä.
Gruß und owT

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige