[Excel] Systemkreuzklick abfangen

[volti]

Liebe Leserin, lieber Leser,

will man verhindern, dass Excel über das Systemkreuz "X" oben rechts neben dem Caption beendet wird, kann man das neben anderen Methoden (wie z.B. eine globale Variable mit entsprechender Information setzen und abfragen usw.) auch durch die Abfrage des Systemkreuzklicks steuern.

Denkbar sind auch andere Anforderungen, bei denen man wissen muss, ob der User diese Beendigungsmöglichkeit angeklickt hat.

Hier mal ein Beispiel dazu: (Der Code kommt in DieseArbeitsmappe)

Code:

Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
        ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32" ( _
        ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long

Private Type RECT
  Left   As Long
  Top    As Long
  Right  As Long
  Bottom As Long
End Type

Private Type POINTAPI
  x As Long
  y As Long
End Type

Function CheckSystemkreuzClick() As Boolean
  Dim PT As POINTAPI, R As RECT
 
  GetCursorPos PT                               ' Mausposition holen
  ScreenToClient Application.hwnd, PT           ' Koordinaten umrechnen auf Fenster
  GetWindowRect Application.hwnd, R             ' Maße des Excelfensters holen
  If PT.x < R.Right And PT.x > (R.Right - 68) And _
     PT.y > R.Top And PT.y < R.Top + 50 Then CheckSystemkreuzClick = True
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If CheckSystemkreuzClick Then
     MsgBox "Bitte nicht über das Systemkreuz beenden!", vbExclamation
     Cancel = True: Exit Sub
  End If
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'  Kurzform ohne Information
'  Cancel = CheckSystemkreuzClick
'End Sub

_________
viele Grüße
Karl-Heinz

[volti]

Hallo Forum,

nachfolgend ein Update zum Thema, das jetzt auch bei Nichtvollbild von Excel funktioniert und erfreulicherweise mit noch weniger Code auskommt.

Code:

Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
        ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type RECT
  Left   As Long
  Top    As Long
  Right  As Long
  Bottom As Long
End Type

Private Type POINTAPI
  x As Long
  y As Long
End Type

Function CheckSystemkreuzClick() As Boolean
  Dim PT As POINTAPI, R As RECT
 
  GetCursorPos PT                               ' Mausposition holen
  GetWindowRect Application.hwnd, R             ' Maße des Excelfensters holen
  If PT.x < R.Right And PT.x > (R.Right - 68) And _
     PT.y > R.Top And PT.y < R.Top + 50 Then CheckSystemkreuzClick = True
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If CheckSystemkreuzClick Then
     MsgBox "Bitte nicht über das Systemkreuz beenden!", vbExclamation
     Cancel = True: Exit Sub
  End If
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'  Kurzform ohne Information
'  Cancel = CheckSystemkreuzClick
'End Sub

_________
viele Grüße
Karl-Heinz