Fenster nicht über "X" schließen
17.03.2013 12:05:04
Michael
ich habe im Netz den folgenden Code gefunden und angepasst, der meine Wünsche fast vollständig erfüllt. D.h. ich kann meine Fenstergröße einstellen, die Menüleiste usw. ausblenden, das Fenster ist nicht immer im Vordergrund.
Jetzt fehlt mir noch die Funkion das schließen des Fensters über das "X" oben rechts im Fenster zu verhindern bzw. das "X" auszublenden. Ich habe jetzt schon viele Stunden rumexperimentiert aber keine zufriedenstellende Lösung gefunden.
Ich hoffe es kann mir geholfen werden.
Hier mein Code für das Modul1
Option Explicit
Option Private Module
Declare Function SetWindowPos Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare Function MoveWindow Lib "user32" ( _
ByVal hWnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long
Private Declare Function SetDoubleClickTime Lib "user32" ( _
ByVal wCount As Long) As Long
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
Private lng_Dctime As Long
Private Const GWL_STYLE = -16
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WM_PAINT = &HF
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const XL_WIDTH = 850 'vorgegebene Breite der Anzeige
Private Const XL_HIGHT = 600 'vorgegebene Höhe der Anzeige
'Fenster einfrieren
Public Sub Fix_Application()
Dim lnghWnd As Long
lnghWnd = FindWindow("XLMAIN", vbNullString)
SetWindowLong lnghWnd, GWL_STYLE, GetWindowLong(lnghWnd, GWL_STYLE) _
And Not (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
DrawMenuBar lnghWnd
MoveWindow lnghWnd, GetSystemMetrics(SM_CXSCREEN) / 2 - XL_WIDTH / 2, _
GetSystemMetrics(SM_CYSCREEN) / 2 - XL_HIGHT / 2, XL_WIDTH, XL_HIGHT, WM_PAINT
SetWindowPos lnghWnd, HWND_NOTOPMOST, GetSystemMetrics(SM_CXSCREEN) / 2 - XL_WIDTH / 2, _
GetSystemMetrics(SM_CYSCREEN) / 2 - XL_HIGHT / 2, XL_WIDTH, XL_HIGHT, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
lng_Dctime = GetDoubleClickTime
SetDoubleClickTime 1
End Sub
'Fenster freigeben
Public Sub Unfix_Application()
SetDoubleClickTime lng_Dctime
Application.WindowState = xlMaximized
End Sub