mousemove / hover-Effekt bei Buttons im Sheet

[junjor]

Hallo Leute,

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 modern aussehen 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?

Viele Grüße
Micha

[volti]

Hallo Micha,

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.


  Mouseover.xlsb (Größe: 29,85 KB / Downloads: 6)

Code:

Option Explicit

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

          
Dim hHook    As LongPtr
Dim oActShp  As Object

Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const HC_ACTION = &H0
Const WH_MOUSE_LL = 14

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

[schauan]

Hallöchen,

hier wäre mal noch die Timer-Variante, 32 und 64 bit

[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.  

Insofern vielen Dank auch für deinen Beitrag!

Gruß,
Micha

[volti]

Hallo Micha,

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)


  Mouseover.xlsb (Größe: 31,8 KB / Downloads: 6)

Gruß
Karl-Heinz

[junjor]

Hallo Karl-Heinz,

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   

[junjor]

Hallo Karl-Heinz,

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...  

Sonst ist alles top!  

[volti]

Hallo Micha,

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

[junjor]

alles klar,  dann habe ich es verstanden und werde es bei deinem Pfeil belassen.

Gruß,
Micha

[volti]

Hallo Micha,

Du hast doch sicher jetzt allen Button ein Makro zugewiesen?
Dann müsste die Hand ja kommen, wenn Du den Code ausremmst.

Oder wie löst Du sonst durch Draufklicken eine Aktion aus?

Gruß
Karl-Heinz