Schleife durch Klick vorzeitig beenden

Beispieldatei (schleife_verlassen.zip 17 kB)

Sie möchten eine Schleife verlassen?
Kein Problem, werden sie jetzt sagen. Was aber ist, wenn das durch einen Klick auf einen Button passieren soll?
Geht auch noch. Sie deklarieren einfach eine mappenweit gültige Abbruchvariable, platzieren einen Button ins Tabellenblatt und in diesem Klickereignis setzten sie Abbruchvariable auf Wahr. Ein einfaches DoEvents in der Schleife reicht aus, damit der Klick auch abgearbeitet wird. In der Schleife überprüfen sie dann den Wahrheitswert der Variablen und brechen entsprechend ab.

Das klappt aber nicht richtig, wenn der Abbruchbutton in einer Userform sitzt und eine dort gestartete Schleife unterbrechen soll. Was tun?
Man kann überprüfen, ob ein Mausklick mit der linken Taste erfolgt ist, wenn ja, schaut man nach, ob die aktuelle Cursorposition im Bereich des Abbruchbuttons liegt. Ist das der Fall, wird abgebrochen.
Das größte Problem dabei ist die Umrechnung der Buttonposition in Screenkoordinaten.

In das Klassenmenü der Userform: 

Option Explicit
Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
Private Declare Function GetAsyncKeyState Lib "user32" _
   (ByVal vKey As Long) As Integer
Private Declare Function GetWindowRect Lib "user32" _
   (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" _
   (lpPoint As POINTAPI) As Long
Private Declare Function GetWindow Lib "user32" _
   (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Const GW_CHILD = 5
Private Const VK_LBUTTON = &H1

Private Function MausKlickImAbbruchbereich() As Boolean
Dim udtFenster As RECT, udtAbbruchbutton As RECT
Dim udtMauspos As POINTAPI, sCaption As String
Static dUmrX As Double, dUmrY As Double, hForm As Long
'Überprüfen, ob mit linker Maustaste geklickt wurde
If GetAsyncKeyState(VK_LBUTTON) = 0 Then Exit Function
If hForm = 0 Then
   'Ursprüngliche Caption speichern
   sCaption = Me.Caption
   'Caption auf einen einmaligen Wert setzen
   Me.Caption = "ztrgdfrsre"
   'Handle der Form holen
   hForm = FindWindow(vbNullString, Me.Caption)
   'Abmessungen der Form in Pixel holen
   GetWindowRect hForm, udtFenster
   'Umrechnungsfaktoren holen
   With udtFenster
      dUmrX = (.Right - .Left) / Me.Width
      dUmrY = (.Bottom - .Top) / Me.Height
   End With
   'Handle auf Clientbereich der Form
   hForm = GetWindow(hForm, GW_CHILD)
   'Ursprüngliche Caption wiederherstellen
   Me.Caption = sCaption
End If
'Abmessungen in Pixel
GetWindowRect hForm, udtFenster
'Position und Abmessung des Abbruchbuttons in Pixel
'bezogen auf den Screen ermitteln
With udtAbbruchbutton 'cmbEnde
   .Left = udtFenster.Left + cmbEnde.Left * dUmrX
   .Right = .Left + cmbEnde.Width * dUmrX
   .Top = udtFenster.Top + cmbEnde.Top * dUmrY
   .Bottom = .Top + cmbEnde.Height * dUmrY
End With
'Mausposition ermitteln
GetCursorPos udtMauspos
'Überprüfen, ob Klick im Bereich des Abbruchbuttons
With udtAbbruchbutton
   If (udtMauspos.X >= .Left) And (udtMauspos.X <= .Right) Then
      If (udtMauspos.Y >= .Top) And (udtMauspos.Y <= .Bottom) Then
         'Klick auf Abbruchbutton
         MausKlickImAbbruchbereich = True
      End If
   End If
End With
End Function

Private Sub cmbStart_Click()
Dim i As Long
On Error GoTo Fehlerbehandlung
Do
   i = i + 1
   'Nach jedem 10. Durchlauf auf Klick prüfen
   If i Mod 10 = 0 Then
      Me.Caption = "Durchlauf : " & i
      If MausKlickImAbbruchbereich Then Exit Do
   End If
Loop
Fehlerbehandlung:
Me.Caption = "Schleife vorzeitig beenden"
End Sub