Infofeld wenn man mit Maus über Button fährt

[DieMarie]

Hallo zusammen,

vor einiger Zeit habe ich mal eine Userform gebaut. 
Wenn man mit der Maus über einen Button gefahren ist den man anklicken konnte ging ein kleines Infofenster auf in dem zusätzliche Erklärungen standen. 

Kann man sowas auch außerhalb einer Userform bauen? Also bei einem normalen ActiveX Steuerelement das direkt auf einem Arbeitsblatt liegt?

[{Boris}]

Hi,

die ActiveX-Elemente haben keine ControlTipText-Eigenschaft. Möglicherweise kann man das MouseMove-Ereignis (zusammen mit ein paar APIs) nutzen, um es "nachzubauen" - fachlich bin ich da aber raus.

[volti]

Hallo Marie, 

anknüpfend an Boris' Ausführungen hier mal eine Idee als Anregung, wie man das machen könnte.

Man kann sich über die API selbst kleine Textboxen programmieren oder aber, wie in diesem Fall, einfach eine Textbox einfügen und mit Bordmitteln so gestalten, wie es gewünscht ist.
Mit dem ersten Mousemove (Event) auf dem betroffenen Button wird die gewünschte Textbox erstellt und nach Verlassen des Buttons wieder gelöscht. Da es für das Verlassen des Buttons keinen passenden Event gibt, setzen wir einfach einen Timer, in dessen TimerProc das Verlassen des Buttons geprüft wird. Anschließend wird Timer und Textbox wieder ausgeschaltet.
PS: Der Timer muss auf jeden Fall ausgeschaltet werden, deshalb bitte auch bei Verlassen der Tabelle und ggf. beim Schließen der Mappe dieses sicher stellen. (KillTimer)

Die Positionierung der Notiztextbox habe ich jetzt in der Butttonprozedur "hart" verdrahtet. Mit dieser Methode kannst Du jetzt beliebig viele Buttons mit so einer Notizbox erstellen.

Probiere es einfach mal aus und gestalte es in Deinem Sinne.

Code:

'###### In ein Codemodul #####
Option Explicit

Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
        lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X      As Long
    Y      As Long
End Type
Dim Pt     As POINTAPI

Private hTimer As LongPtr

Sub Timer_Tick()
 Dim oCurObj As Object
 
 DoEvents
 GetCursorPos Pt                                    ' Mausposition holen
 On Error Resume Next
 Set oCurObj = Application.Windows(1).RangeFromPoint(Pt.X, Pt.Y)
 If Err <> 0 Then Err.Clear: Exit Sub               ' Fehler => raus

 If TypeName(oCurObj) <> "OLEObject" Then
    If hTimer <> 0 Then
       KillTimer 0&, hTimer: hTimer = 0
       ActiveSheet.Shapes.Range("Notiz").Delete
    End If
 End If
 
End Sub


Sub CreateNotiz(sText As String, X As Long, Y As Long, B As Integer, H As Integer)
' Hier das Objekt formatieren
  Dim Obj As Object
  
  If hTimer <> 0 Then Exit Sub
  
  Set Obj = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, B, H)
  Obj.Name = "Notiz"
  With Obj.TextFrame2.TextRange.Characters
       .Font.Size = 9
       .Font.Name = "Arial"
       .Text = sText
  End With
  With Obj.Fill
       .Visible = msoTrue
       .ForeColor.RGB = RGB(255, 255, 240)
       .Transparency = 0
       .Solid
  End With
  hTimer = SetTimer(0&, 0&, 25, AddressOf Timer_Tick)
End Sub


'###### In das Tabellenmodul #####
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Erstellt eine Notiz
  CreateNotiz "Mein kleiner Test", 510, 25, 100, 20
End Sub

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Erstellt eine Notiz
  CreateNotiz "Und noch eine Notiz", 510, 75, 100, 20
End Sub

Private Sub Worksheet_Deactivate()
   KillTimer 0&, hTimer: hTimer = 0
End Sub

_________
viele Grüße
Karl-Heinz

[{Boris}]

Hi Karl-Heinz,

danke erstmal für`s "Ball aufnehmen" 
Bin mal wieder begeistert von dem Zeugs, das Du da rauchst
Habe nun wieder eine Mustermappe mehr im Ordner "Volti"

[DieMarie]

Super, danke @Volti
Ich muss mal schauen ob ich das bei mir adaptiert bekomme.

[d'r Bastler]

Moin!

Und meiner einer hätte dann wieder dümmlich vorgschlagen: Mach doch 'ne Userform!

Geiler Code und echt was für's Album, volti! Danke!!

Gruß

[volti]

Vielen Dank Euch,

für die positiven Rückmeldungen.

Habe das Thema noch ein wenig weiter ausgebaut. Findet man bei den Komplettlösungen....

Gruß
Karl-Heinz

[Fennek]

Hallo,

die Lösung von Volti finde ich prima und habe sie gleich gespeichert.

Da ich mit API's einige Probleme habe, versuchte ich eine einfachere Variante:

Der Code schreibt die Adresse der selektierten Zelle in den "StatusBar", wenn für jede relevate Zelle eine Text hinterlegt wird, könnte es die Frage auch einigermaßen beantworten:

Code:

Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type


Sub T_1()
Dim MPos As POINTAPI
Dim WS As Worksheet
Dim c As Range
Set WS = ActiveSheet

RetVal = GetCursorPos(MPos)
Set c = ActiveWindow.RangeFromPoint(MPos.x, MPos.y)
Debug.Print c.Address
c.Interior.Color = vbYellow
Application.StatusBar = c.Address
End Sub

In der Beispiel-Datei wird der Code durch ein "Sheet_SelectionChange()" aufgerufen.

mfg

PS: Für Excel 32-bit einfach das "PtrSafe" löschen

[maninweb]

Moin,

PS: Für Excel 32-bit einfach das "PtrSafe" löschen

nee, muss nicht. Ganz im Gegenteil, bitte drin lassen. PtrSafe müsste nur bei einer Excel-Version < Excel 2010 entfernt
oder per bedingter Kompilierung umgangen werden, weil die alten Versionen PtrSafe nicht kennen.

Gruß

[schauan]

Hallöchen,

hier mal noch 'ne Variante, gleiche Basis. Hab heute nur das ptrsafe und longptr eingefügt, dank an Karl Heinz, , der code stammte noch aus alten Zeiten ...