Ouvrir UserForm et cacher le classeur

Bonjour,

J'ai utilisé ce code pour ouvrir seulement le UserForm et cacher le classeur (Seulement concerné);

SVP, Je veux vérifier ce code. Est-ce efficace ?

Merci.

thisworkbook :

Private Sub Workbook_Open()
On Error Resume Next
Set AppClass.AppXL = Application
If Application.Workbooks.Count = 1 Then
  Application.Visible = False
Else
  ThisWorkbook.Windows(1).Visible = False
End If
UserForm1.Show vbModeless
If Err Then ThisWorkbook.Saved = True: If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub

UserForm

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim FM
If Application.Workbooks.Count = 1 Then
  If Application.Visible = False Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
'      ThisWorkbook.Save
      Application.Quit
     Else
       Cancel = True
    End If
  End If
 Else
 If Application.Visible = True Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
'      ThisWorkbook.Save
      ThisWorkbook.Close
     Else
       Cancel = True
    End If
  End If
End If
End Sub

Module

Option Explicit

Public AppClass As New Classe1
Public UserFormVisible As Boolean

classe module

Option Explicit
Public WithEvents AppXL As Application

Private Sub AppXL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Application.Workbooks.Count = 2 Then
  Application.Visible = False
  If UserFormVisible = False Then UserForm1.Show vbModeless
Else
  ThisWorkbook.Windows(1).Visible = False
End If
End Sub

Bonjour,

Une autre méthode consiste à donner au userform les dimensions de ton écran > masquant ainsi Excel en arrière plan ...

Private Sub UserForm_Initialize()

    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

ric

Bonjour ric,

Merci pour votre attention

En fait, je veux vérifier l'efficacité des codes précédents parce que je souhaite utiliser ce code pour agrandir et reduire le userform.

Mais ce problème m'apparaît

Module

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLongA As Long) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "User32" (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 PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long

    Private Declare PtrSafe Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    Private Declare PtrSafe Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
    Private Declare PtrSafe Function EnableMenuItem Lib "User32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, _
        ByVal wEnable As Long) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

#Else
   ' Private
   Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   Private Declare Function SetWindowPos Lib "User32" (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 FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
   Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
   Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
   Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long

   Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
   Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
   Private Declare Function EnableMenuItem Lib "User32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, _
        ByVal wEnable As Long) As Long
   Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

#End If

' Déclaration des constantes
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_FULLSIZING = &H70000
'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Const mcGWL_STYLE = (-16)
Private Const mcWS_SYSMENU = &H80000

Private Const MF_ENABLED = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_BYPOSITION = &H400
Private Const C_USERFORM_CLASSNAME = "ThunderDFrame"

'Attention, envoyer après changement du caption de l'UF
Public Sub InitMaxMin(mCaption As String, Optional Max As Boolean = True, Optional Min As Boolean = True _
        , Optional Sizing As Boolean = True)
        On Error Resume Next
Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, mCaption)
    If Max Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MAXIMIZEBOX
    If Min Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX
    If Sizing Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_FULLSIZING
End Sub

Sub AddIcon(myForm)
'Add an icon on the titlebar
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sheet1.Image1.Picture.Handle
    hWnd = FindWindow(vbNullString, myForm.Caption)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    lngRet = DrawMenuBar(hWnd)
End Sub

 Sub AddMinimizeButton()
'Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLongA(hWnd, GWL_STYLE, _
                       GetWindowLongA(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

 Sub AppTasklist(myForm)
'Add this userform into the Task bar
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLongA(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLongA(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

Public Sub subRemoveCloseButton(frm As Object)
    Dim lngStyle As Long
    Dim lngHWnd As Long

    lngHWnd = FindWindow(vbNullString, frm.Caption)
    lngStyle = GetWindowLongA(lngHWnd, mcGWL_STYLE)

    If lngStyle And mcWS_SYSMENU > 0 Then
        SetWindowLongA lngHWnd, mcGWL_STYLE, (lngStyle And Not mcWS_SYSMENU)
    End If

End Sub

Function EnableCloseButton(UF As MSForms.UserForm, Disable As Boolean) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EnableCloseButton
' This function enables (if Disable is False) or disables (if
' Disable is True) the "X" button on a UserForm UF.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim UFHWnd As Long
Dim hMenu As Long
Dim ItemCount As Long
Dim Res As Long

' Get the HWnd of the UserForm.
UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    EnableCloseButton = False
    Exit Function
End If
' Get the menu handle
hMenu = GetSystemMenu(UFHWnd, 0&)
If hMenu = 0 Then
    EnableCloseButton = False
    Exit Function
End If

ItemCount = GetMenuItemCount(hMenu)
If Disable = True Then
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)
Else
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_ENABLED Or MF_BYPOSITION)
End If
If Res = -1 Then
    EnableCloseButton = False
    Exit Function
End If
DrawMenuBar UFHWnd

EnableCloseButton = True

End Function

Function HWndOfUserForm(UF As MSForms.UserForm) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HWndOfUserForm
' This returns the window handle (HWnd) of the userform referenced
' by UF. It first looks for a top-level window, then a child
' of the Application window, then a child of the ActiveWindow.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WinHWnd As Long
Dim UFHWnd As Long
Dim Cap As String
Dim WindowCap As String

Cap = UF.Caption

' First, look in top level windows
UFHWnd = FindWindow(C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a top level window. Search for child of application.
AppHWnd = Application.hWnd
UFHWnd = FindWindowEx(AppHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a child of the application.
' Search for child of ActiveWindow (Excel's ActiveWindow, not
' Window's ActiveWindow).
If Application.ActiveWindow Is Nothing Then
    HWndOfUserForm = 0
    Exit Function
End If
'WinHWnd = WindowHWnd(Application.ActiveWindow)
UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
HWndOfUserForm = UFHWnd

End Function

userform

Option Explicit
Dim Lg As Single
Dim Ht As Single
Dim Fini As Boolean

Private Sub UserForm_Activate()
    Dim B As Boolean
    'subRemoveCloseButton Me
    'Application.Visible = False
    AddMinimizeButton   'Add a Minimize button to Userform
    AppTasklist Me    'Add this userform into the Task bar
    'B = EnableCloseButton(UF:=Me, Disable:=True)
    InitMaxMin Me.Caption
    '==============
    Ht = Me.Height
    Lg = Me.Width
    Application.WindowState = xlMaximized
'If Application.Workbooks.Count = 1 Then
' Application.Visible = False
'Else
'ThisWorkbook.Windows(1).Visible = False
'End If
End Sub

Private Sub UserForm_Resize()
    Dim RtL As Single, RtH As Single
        If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
        RtL = Me.Width / Lg
        RtH = Me.Height / Ht
        Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
End Sub

Bonjour ANASS1, Ric,

La séparation code Module et code Userform ne me semble pas idéale.

Ensuite au début de ce dernier, partie VBA7, la déclaration Ptrsafe demande une variable LongPtr au lieu de Long dans le code Byval entre parenthèses.

Voir exemple dans le fichier: Mindo

Au sein de la feuille formulaire.