24.06.2023, 18:45
Moin,
nachfolgend eine kleine API Funktion, welche die Position eines Shapes überwacht. Kann z. B. genutzt werden, wenn (M)man(n) überprüfen möchte, ob etwas an der richtigen Position ist bzw. verschoben wurde.
Der Code:
Und die Datei.
[attachment=48533]
nachfolgend eine kleine API Funktion, welche die Position eines Shapes überwacht. Kann z. B. genutzt werden, wenn (M)man(n) überprüfen möchte, ob etwas an der richtigen Position ist bzw. verschoben wurde.
Der Code:
Code:
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 lngTimer As LongPtr
Dim dblXAchse As Double
Dim dblYAchse As Double
Private shpShape As Shape
Sub StartTimer()
Set shpShape = Tabelle1.Shapes("Ellipse 2")
dblXAchse = shpShape.Top
dblYAchse = shpShape.Left
lngTimer = SetTimer(0, 0, 300, AddressOf CheckShape)
End Sub
Sub StopTimer()
KillTimer 0, lngTimer
End Sub
Sub CheckShape()
On Error Resume Next
With shpShape
If .Top <> dblXAchse Or .Left <> dblYAchse Then
StopTimer
shpShape.Top = dblXAchse
shpShape.Left = dblYAchse
Set shpShape = Nothing
MsgBox "Kreis bewegt!"
StartTimer
End If
End With
On Error GoTo 0
End SubUnd die Datei.
[attachment=48533]