dotNETportal.cz

Lze nějakým Příkazem nebo funkcí vypnout na formuláři (VBA Exel 2010) zavírací křížek formuláře?

UserForm1.Enabled=False nemohu použít. Formulář se zavírá Tlačítkem na formuláři které spouští další akce. Při zavření křížkem se tyto akce neprovedou a to nemohu potřebovat. Vytvářím program který musí být maximálně "blbovzdorný".

Option Explicit
'http://support.ge-ip.com/support/index?page=kbchannel&id=S:KB6521&actp=search
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) 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 SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

' GetWindowLong Constant
Private Const GWL_STYLE = -16
Private Const WS_SYSMENU = &H80000
' Windows message constant.
Private Const WM_NCPAINT = &H85
Private mhWnd As Long

Public Property Get hWnd() As Long
    hWnd = mhWnd
End Property

Private Property Get ShowSystemMenu() As Boolean
    On Error GoTo HandleErrors
    Dim lngOldStyle As Long
    lngOldStyle = GetWindowLong(Me.hWnd, GWL_STYLE)
    ShowSystemMenu = ((lngOldStyle And WS_SYSMENU) = WS_SYSMENU)
ExitHere:
    Exit Property
HandleErrors:
End Property
Private Property Let ShowSystemMenu(ShowIt As Boolean)
    On Error GoTo HandleErrors
    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    If ShowSystemMenu = ShowIt Then
        Exit Property
    End If

    ' Get the current window style of the form.
    lngOldStyle = GetWindowLong(Me.hWnd, GWL_STYLE)

    If ShowIt Then
        ' Turn on the bit that enables system menu.
        lngNewStyle = lngOldStyle Or WS_SYSMENU
    Else
        ' Turn off the bit the shows the system menu.
        lngNewStyle = lngOldStyle And Not WS_SYSMENU
    End If

    ' Set the new window style.
    Call SetWindowLong(Me.hWnd, GWL_STYLE, lngNewStyle)
    ' The 1 as the third parameter tells
    ' the window to repaint its entire border.
    Call SendMessage(Me.hWnd, WM_NCPAINT, 1, 0)

ExitHere:
    Exit Property
HandleErrors:

End Property

'test functionality
Private Sub UserForm_Click()
    ShowSystemMenu = Not ShowSystemMenu
End Sub

Private Sub UserForm_Initialize()
    mhWnd = FindWindow("ThunderDFrame", Me.Caption)
    ShowSystemMenu = False
End Sub