06.04.2023, 14:17
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)
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
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
viele Grüße
Karl-Heinz