'###### 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