es geht um einen einfachen hover-effect auf selbst erstellte Buttons (dazu habe ich per "Einfügen" - "Formen" ein simples Rechteck benutzt). Ich möchte, dass der Button bzw. die Form z.B. die Farbe wechselt, wenn man mit der Maus drauf kommt. So, wie auf Homepages auch. Ich weiß, dass dieses Thema rein geschmacklich die Coder-Szene polarisieren kann , aber ich möchte trotzdem mal höflich nach der reinen Funktionsweise fragen, die ich auch nach langer Suche im Netz und im Forum noch nichts passendes gefunden habe. Meine Intention ist, die Tabelle vor allem modernaussehen zu lassen und dazu fände ich die hover-effekte persönlich ganz cool.
Das Problem bzw. die Fragestellung scheint es ja immer mal wieder irgendwie zu geben aber ich finde immer nur Lösungen für Userforms oder im Zusammenhang mit ToolTips o.ä. Aber mein Button liegt ganz normal in einem Sheet und ist bislang kein CommandButton oder ActivX-Element.
Hat jemand eine Idee? Geht das überhaupt? Oder nur im Zusammenhang mit ActiveX? Kann man vielleicht eine Grafik als Button einfügen und diese mit einem VBA-Code versehen?
Oft sind die Antworten aus den Foren zu ähnlichen Fragen schon viele Jahre alt. Vielleicht hat sich da ja inzwischen bei Excel was getan?
wenn Du Buttons und Objekte außerhalb der ActiveX-Objekte verwenden willst, die also keine Maustriggerfunktionen wie z.B. Mousemove mitbringen, würde man zunächst einmal sagen: Geht nicht.
Mit etwas API-Kram ist das allerdings dann doch möglich.
So kann man sich einen Timer setzen, der z.B. alle 50 Millisekunden nachschaut, wo sich gerade der Mauszeiger befindet und, wenn er sich über dem gewünschten Objekt, z.B. Shape oder Bild befindet, entsprechende Aktionen durchführen.
Oder man arbeitet mit sogenanntem Mousehooking, d.h. bevor Windows die Message der Mousemoveaktivität an Excel weitergibt, wird sie von Deinem Programm abgefangen und verarbeitet. Das Mousehooking sollte aber unbedingt auch wieder abgeschaltet werden, z.B. wenn das Blatt verlassen wird und/oder die Mappe geschlossen wird.
Hier mal ein Beispielcode... Benutze zum Testen aber unbedingt die beigefügte Mappe.
Public Const bNoMouseHooking = False ' Zum Bearbeiten auf True setzen
Private Type POINTAPI X As Long Y As Long End Type Dim Pt As POINTAPI
Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Dim R As RECT
Private Declare PtrSafe Function SetWindowsHookExA Lib "user32" ( _ ByVal idHook As Long, ByVal lpfn As LongPtr, _ ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _ ByVal hHook As LongPtr, ByVal nCode As Long, _ ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As LongPtr) As Long Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _ lpPoint As POINTAPI) As Long Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _ ByVal hwnd As LongPtr, lpRect As RECT) As Long Private Declare PtrSafe Function ScreenToClient Lib "user32" ( _ ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
Sub MausAus() ' Beendet den Mousehook UnhookWindowsHookEx hHook: hHook = 0 End Sub
Sub MausAn() ' Baut den Mousehook auf If bNoMouseHooking = True Then Call MausAus: Exit Sub If hHook = 0 Then hHook = SetWindowsHookExA(WH_MOUSE_LL, AddressOf MouseProc, _ Application.HinstancePtr, 0) End If End Sub
Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, _ lParam As LongPtr) As LongPtr Dim oCurObj As Object
If nCode = HC_ACTION Then GetCursorPos Pt
Select Case wParam Case WM_LBUTTONDOWN ' Abschalten über das Caption-Kreuz ScreenToClient Application.hwnd, Pt GetWindowRect Application.hwnd, R If Pt.X < R.Right And Pt.X > (R.Right - 68) And _ Pt.Y > R.Top And Pt.Y < R.Top + 50 Then Call MausAus End If
Case WM_MOUSEMOVE On Error Resume Next Set oCurObj = ActiveWindow.RangeFromPoint(Pt.X, Pt.Y) If Err <> 0 Then Exit Function ' Fehler => raus
Select Case TypeName(oCurObj) Case "Nothing" ' Außerhalb des Tabellenbereichs Case "Range" If Not oActShp Is Nothing Then oActShp.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 255) Set oActShp = Nothing Application.Cursor = xlDefault End If Case "OLEObject" ' Nicht zu verarbeitende Objekte Case Else If oActShp Is Nothing Then oCurObj.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0) Application.Cursor = xlNorthwestArrow ElseIf oActShp.Name <> oCurObj.Name Then oActShp.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 255) Application.Cursor = xlDefault End If Set oActShp = oCurObj End Select
End Select Exit Function End If MouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
_________ viele Grüße Karl-Heinz
Folgende(r) 3 Nutzer sagen Danke an volti für diesen Beitrag:3 Nutzer sagen Danke an volti für diesen Beitrag 28 • , Andrek, junjor
06.11.2021, 23:44 (Dieser Beitrag wurde zuletzt bearbeitet: 06.11.2021, 23:48 von junjor.)
Hallo Karl-Heinz,
wieder vielen Dank für deine Antwort und den schnellen und tollen Lösungsvorschlag! Ich habe den Code in deiner Mappe ausprobiert und er funktioniert im Prinzip perfekt!!
Das einzige "Problem", was dabei nun auftaucht, ist, dass ich in meinem Sheet neben einer Menüleiste bestehend aus Buttons auch noch weitere Formen benutze, in denen z.B. nur Text steht und die eigentlich nicht gehovert werden sollen. Dein Code hovert beim MouseOver jetzt allerdings ALLE Form-Elemente im Sheet und alle mit derselben Farbeinstellung. Man kann scheinbar die Elemente nicht einzeln ansprechen und farblich individuell hovern bzw. einige gar nicht hovern.
Ich weiß, dass das "jammern auf hohem Niveau" ist, da ich ja theoretisch (außer den wichtigen Menü-Buttons) auch auf die weiteren Form-Elemente verzichten könnte... Aber vielleicht gibt es ja sogar auch dafür noch eine Code-Anpassung, die mit Blick auf den Arbeitsaufwand verhältnismäßig erscheint?
Ich habe dir hier mal deine Beispieldatei auf mein Problem eingestellt...
Einen schönen Abend noch und nochmals Danke Hallo schauan,
diese Variante ist auch sehr interessant und ich werde sie mit Sicherheit zukünftig gut gebrauchen können.
Dein Einwand ist berechtigt und war mir eigentlich auch klar. Da ich aber Deine Aufgabenstellung nicht genau kannte, war es ein Erstvorschlag. Kernaufgabe ist das Abfangen der Mausaktivitäten für Shapes und Objekte. Was dann im Einzelnen daraus gemacht wird, ist eine weiterführende Geschichte.
Ich habe jetzt den Aktionsteil in eine eigene Sub ausgelagert, in der Du jetzt für jedes Element oder auch für Gruppen die gewünschte Aktion programmieren kannst. Das ist natürlich nicht auf die Farbänderung beschränkt, es kann auch eine Größenänderung oder das Zuschalten eines Tooltips und mehr sein.
In der neuen Beispieldatei habe ich die Buttons umbenannt, so dass nicht alle einzeln genannt werden müssen. Die Smileys sind überlappend; hier muss (und ist) der Übergang extra programmiert werden, da ja nicht in den Rangebereich zurückgegangen wird.
Auch ich habe hier Varianten über den Timer wie Andre es gezeigt hat. Die ist allerdings deutlich langsamer und macht bei schnellen Mausbewegungen Probleme. Außerdem geht sie auf die Performance, da ständig die Mausposition abgearbeitet wird, das Hooking reagiert nur auf wirkliche Mausbewegungen.
Hier das Update: (und wie gesagt, man kann alles machen)
deine Beispieldatei entspricht jetzt genau dem, was ich mir gewünscht hatte! Ich werde das morgen Abend mal voller Vorfreude in meine Echtdatei überführen und testen, wobei ich davon ausgehe, dass das klappen wird.
Tja, ich bin begeistert und sprachlos zu gleich! Und ich wünschte, ich hätte auch so viel Ahnung, um so schnell solche ausgefeilten Hilfestellungen geben zu können... Aber Excel macht echt Spaß und dank eurer Hilfe lerne ich sehr viel dazu! (aber diese tiefgreifenden API-Codes und Deklarierungen sind mir -noch- einige Nummern zu hoch)
Naja, wieder ein Problem dank dieses Forums gelöst! Insofern kann ich jetzt erstmal beruhigt und dankbar ins Bett
dein Code läuft jetzt auch bei mir in der Echtdatei super!!
Nur eine kleine Nachfrage noch: mir ist jetzt nach Einbau deines Codes aufgefallen, dass der Mauscursor, der zuvor beim Überfahren der Buttons mit der Maus zu einer zeigenden Hand wurde, jetzt zu dem Windows-Standard-Pfeil wird. Kann man den Cursor mit wenig Aufwand wieder bei Erkennen eines Button-Links zu der zeigenden Hand machen? Die fand ich persönlich optisch ansprechender...
die Hand erscheint nur, wenn Du den "Buttons" ein Makro zugewiesen hast, ansonsten bleibt das Kreuz stehen.
Mit Application.Cursor..... hatte ich das Kreuz durch den Pfeil ersetzt, weil es besser aussieht und weil es wohl keine Hand bei den verwendbaren Excelcursors gibt. Wenn ich den Hand-Cursor durch Windows setzen lasse, wird das nicht genommen bzw. gleich von Excel wieder kassiert.
Kurzum: Eliminiere den Code "Application.Cursor" durch Entfernen oder Ausremmen.
Rem Application.Cursor = IIf(bOver, xlNorthwestArrow, xlDefault)
Gruß Karl-Heinz
Folgende(r) 1 Nutzer sagt Danke an volti für diesen Beitrag:1 Nutzer sagt Danke an volti für diesen Beitrag 28 • junjor