Microsoft 365 Forcer l'affichage de mon userform (barre de progression) sur l'écran où le classeur est actif (cas des doubles/triples écrans)

[Le_Phénomène]

Bonjour,

Dans l'un de mes projets, je fais afficher une barre de progression via un userform afin de faire "patienter" l'utilisateur (et histoire que ce dernier ne panique pas trop lors de traitements un peu longuais 😉 - ça les rassure) :

Sauf que... selon les configurations des uns et des autres, de leur choix d'ouvrir/placer le classeur Excel sur tel ou tel écran (l'équipe dispose tous d'un double écran avec affichage étendu et certain utilise même leur laptop comme troisième écran), mon userform s'affiche toujours par défaut sur l'écran principal définit dans les paramètres Windows.

Donc pas de souci lorsque l'utilisateur à son classeur ouvert sur le moniteur déclaré comme écran principal mais c'est bof lorsqu'il a décidé de placer son classeur sur l'un des écrans secondaire.

Je souhaiterai donc pouvoir :
1- savoir sur quel écran est activé le classeur Excel qui mouline
2- forcer l'affichage de mon userform sur ledit écran

Si un éminant expert à une solution ou une voie sur laquelle je peux m'orienter, je l'en remercie par avance.

En vous souhaitant une bien agréable journée.
Franck

 

[Dudu2]

qu'avant d'ajouter ou de supprimer une properties, il n'est pas nécessaire de tester si elle y est déjà

Je n'ai jamais dit ni fait le contraire. Pour forcer un bit à 0 ou 1 pas besoin de savoir quelle est sa valeur.

 

[Dudu2]

A noter que si tu n'utilises pas le GetWindowLong, et que tu pars de WS_SYSTEMO = &H94C80080, ça sert à rien de faire un AND avec Not WS_CAPTION puisque c'est le C qu'il faut mettre à 0.

Un SetWindowLongPtr UserFormHandle, GWL_STYLE, &H94080080 suffit.
Comme quoi tu peux faire toujours plus court ! 😛

 

[patricktoulon]

re
c'est exactement ce que je t'ai dit plus tot dans la discussion
voila pourquoi je me sert de l'address du complet

 

[patricktoulon]

Bonjour à tous
@Dudu2
comme je te l'ai dit si je me creuse un peu la tête on peut tout faire en logical Addition
pour le coup j'ai tout fait dans un seule fonction
et pour le coup je travaille avec les constantes connues

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'Window menu setting function
'use of the principle of logical addition
'Author Patricktoulon
'version 1.2
'Date version:22/11/2024
'principle
'1° The principle consists of compiling all the configuration constants of the system menu in positive mode(Or)
'2° then we will compile in negative everything that we do not want in variable suppr
'3° all we have to do is apply the positive parameters and subtract (And Not) the parameters that we don't want with variable [suppr]
'
'Function available for Excel 2007 to Excel 2024 32/64 bytes
'this function display the window if it is not displayed
'----------------------------------------------------------------------------------------------------
Option Explicit
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

#End If

Private Const WS_DLGFRAME = &H400000
Private Const WS_BORDER = &H800000
Private Const WS_CAPTION = &HC00000 'WS_BORDER Or WS_DLGFRAME
Private Const WS_SYSMENU = &H80000
Private Const WS_SIZEBOX = &H40000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const GWL_STYLE = -16

'Private Const WCS_FULL_SYSTEM = &H94CF0080
'Private Const WCS_BASIC_MENU = &H94C80080
'Private Const WCS_NO_MENU = &H94C00080
'Private Const WCS_NO_TitleBar = &H94080080

Sub testOnly_MinimzeButton() 'with Minimize button
    ShowFormWhithout UserForm1, True, True, False, False, True
End Sub
Sub test2_Minimize_And_resize() 'with Minimize button and resize
    ShowFormWhithout UserForm1, True, True, False, True, True
End Sub

Sub test3_Only_Maximize_Button() 'With Maximize button
    ShowFormWhithout UserForm1, True, False, True, False, True
End Sub
Sub test4_Maximize_Button_And_resize() 'With Maximize button and resize
    ShowFormWhithout UserForm1, True, False, True, True, True
End Sub

Sub testFulSystem() 'With fufll options  for style -16
    ShowFormWhithout UserForm1, True, True, True, True, True
End Sub

Sub test5_No_TitleBar() 'without Tile bar
    ShowFormWhithout UserForm1, False
End Sub

Sub test6_No_Close_Button() 'without menu(just TitleBar with No button)
    ShowFormWhithout UserForm1, True, MenuX:=False
End Sub

Sub ShowFormWhithout(UsF As Object, _
                     Optional TitleBar As Boolean = False, _
                     Optional Minimize As Boolean = False, _
                     Optional Maximize As Boolean = False, _
                     Optional Resizeb As Boolean = False, _
                     Optional MenuX As Boolean = False)

    Dim FuLL_Menu&, suppr&, OldInW&, OldInH&, DiFFInH&

    #If VBA7 Then
        Dim H As LongPtr, GWL As LongPtr
    #Else
        Dim H As Long, GWL As Long
    #End If


    OldInW = UsF.InsideWidth
    OldInH = UsF.InsideHeight
    DiFFInH = UsF.Height - OldInH
   
    'FR :Accumulation of all deletion options in positive mode reduced to zero by the boolean argument
    'EN : Accumulation of all positive deletion options reduced to zero by the boolean argument
    suppr = WS_CAPTION And Not TitleBar Or (WS_MINIMIZEBOX And Not Minimize) Or (WS_MAXIMIZEBOX And Not Maximize) _
                                            Or (WS_SIZEBOX And Not Resizeb) Or (WS_SYSMENU And Not MenuX)

    'FR : Accumulation de toute les options en positif (comme si on voulait mettre le menu complet à la fenêtre)
    'EN : Accumulation of all the options in positive (as if we wanted to put the complete menu in the window)
    FuLL_Menu = WS_DLGFRAME Or WS_BORDER Or WS_SYSMENU Or WS_SIZEBOX Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_THICKFRAME

    'we display (show) the window if it is not displayed
    If Not UsF.Visible Then UsF.Show
    UsF.caption = UsF.caption

    'FR :récupère la poignée de la fenêtre(handle)
    'EN :get the window handle (handle)
    H = FindWindow(vbNullString, UsF.caption)

    'FR :Récupération du style actuel de la fenêtre
    'EN :Get current style of the window
    GWL = GetWindowLongPtr(H, GWL_STYLE)

    'FR :application du nouveau style sur la fenêtre
    'FR :en mettant tout(GWL Or FuLL_Menu) et en elevant de qui a été demandé dans les arguments

    'EN :applying the new style to the window
    'EN :by putting everything (GWL Or c) and raising who was asked in the arguments with suppr in negative mode
    SetWindowLongPtr H, GWL_STYLE, (GWL Or FuLL_Menu) And Not suppr


    With UsF
        'To cause the Inside update after the SetWindowLongPtr()
        .Width = .Width + 1
        .Width = .Width - 1
        'approximate correction of dimension errors caused by DWM
        .Width = .Width - (.InsideWidth - OldInW)
        .Height = .Height - (.InsideHeight - OldInH)
        .Top = .Top + DiFFInH * (Abs(Not TitleBar))

    End With
End Sub

ben quand tu enleve les commentaires il ne reste plus grand chose
pour le coup j'ai tout en une y compris la correction du inside sur userform sans barre de titre
et quoi de plus lisible que cela

 

[Dudu2]

Bonsoir @patricktoulon,
Oui, c'est parfait. Ça roule.

 

[patricktoulon]

tu a essayé?

 

[Dudu2]

Oui bien sûr, moi j'essaie 🤓.
J'ai constaté que ça fonctionnait très bien.