reduire un UserForm à caté du menu demarrer

Question

Bonjour ,
avec mon userForm visible &#224; l'ecran je voudrais le reduire en une icone &#224; cot&#233; du menu
demarrer (barre des programmes ouverts)
je voudrais que cela reduise exel dans le meme temps
Comment faire je n'y arrive pas.
merci d'avance
Manu

CTAC · Answer

Bonjour.
Dans un module :

Public Declare Function FindWindow& _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName$, ByVal lpWindowName$)


Public Declare Function GetWindowLong& _
    Lib "user32" Alias "GetWindowLongA" _
    (ByVal hwnd&, ByVal nIndex&)


Public Declare Function SetWindowLong& _
    Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)


Private Declare Function EnableWindow& _
    Lib "user32" _
    (ByVal hwnd&, ByVal fEnable&)


Private Declare Function CallWindowProc& _
    Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)


Public Const GWL_WNDPROC& -4&, WM_SYSCOMMAND& &H112&


Public BaseUFProc&, BaseXLProc&, AncState&


Function UFProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
    Dim HwndXL&
    Const SC_MINIMIZE& = &HF020&
    If uMsg = WM_SYSCOMMAND Then
            If wParam = (SC_MINIMIZE And &HFFF0&) Then
                HwndXL = FindWindow("XLMAIN", Application.Caption)
                EnableWindow HwndXL, True
                UserForm1.Hide
                AncState = Application.WindowState
                Application.WindowState = xlMinimized
                BaseXLProc = SetWindowLong(HwndXL, GWL_WNDPROC, AddressOf XLProc)
                UFProc = 1&
                Exit Function
            End If
    End If
    UFProc = CallWindowProc(BaseUFProc, hwnd, uMsg, wParam, lParam)
End Function


Function XLProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
    Const SC_MAXIMIZE& = &HF030&, _        SC_RESTORE& &HF120&, SC_CLOSE& &HF060&
    If uMsg = WM_SYSCOMMAND Then            If wParam (SC_MAXIMIZE And &HFFF0&) Or wParam (SC_RESTORE _
                And &HFFF0&) Or wParam = SC_CLOSE Then
                SetWindowLong hwnd, GWL_WNDPROC, BaseXLProc
                Application.WindowState = AncState
                UserForm1.Show
                XLProc = 1&
                Exit Function
            End If
    End If
    XLProc = CallWindowProc(BaseXLProc, hwnd, uMsg, wParam, lParam)
End Function

Dans le module UserForm1 :

Private HandleUF&


Private Sub UserForm_Initialize()
    Const WS_MAXIMIZEBOX& = &H10000, _        WS_MINIMIZEBOX& &H20000, GWL_STYLE& -16&
    HandleUF = FindWindow(vbNullString, Me.Caption)
    SetWindowLong HandleUF, GWL_STYLE, _
        GetWindowLong(HandleUF, GWL_STYLE) Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    BaseUFProc = SetWindowLong(HandleUF, GWL_WNDPROC, AddressOf UFProc)
End Sub


Private Sub UserForm_Terminate()
    SetWindowLong HandleUF, GWL_WNDPROC, BaseUFProc
End Sub

ctac

Reduire un UserForm à caté du menu demarrer

1 réponse

Discussions similaires