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]

Je sais ce que sont les opérateurs booléens et comment ils fonctionnent (c'était la base pour le jeune informaticien que je ne suis plus depuis une centaine d'années), mais si tu as des infos sur le problème posé par cette fonction, alors vas-y...

Avant que tu ne te lances, je te rappelle que le Caption peut être supprimé dans le SetWindowLong() avec l'une ou l'autre de ces constantes (moi, je l'ai testé !):
Private Const WS_DLGFRAME = &H400000
Private Const WS_BORDER = &H800000
Private Const WS_CAPTION = WS_BORDER Or WS_DLGFRAME

Et ce n'est pas parce que je l'ai supprimé avec WS_CAPTION que la fonction doit se focaliser seulement sur cette constante sachant qu'un code quelconque peut l'avoir supprimé avec WS_DLGFRAME ou WS_BORDER.

Edit: C'est la raison pour laquelle j'ai codé:

    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
    If iStyle = (iStyle And Not WS_DLGFRAME) _
    Or iStyle = (iStyle And Not WS_BORDER) Then
        IsBordersAndSystemBarRemoved = True
    End If

 

[patricktoulon]

re ben alors tu n'a jamais compris comment ça fonctionnait
quand tu fait par exemple

iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
SetWindowLongPtr UserFormHandle, GWL_STYLE, iStyle And Not WS_CAPTION

tu peux répéter 20 fois cette opération tu aura toujours le même résultat même si iStyle est différent après la première fois

ce n'est pas moins!!! ws_Caption c'est et pas!!! Ws_Caption

conclusion tout les tests Si ce n'est pas ceci ou celà sont inutiles

vois les constantes comme l'ensemble d'un tableau de properties chacune à sa place dans une address mémoire
quand tu fait And not une constante tu vide la place ou se trouve cette constante dans ce tableau de properties
je dis ça schématiquement en fait c'est une address mémoire

constitution schématisée propertie fenêtre
totale
&h80000	bt fermer+barre	agrandir	reduire	resize	long address
	&Hc10000	&h10000	&H20000	&H40000	&H94C80080

quand tu fait and not tu vide une des cases
quand tu fait OR tu met la valeur dans sa case respective(si elle y est déjà ben ça fait rien)
mais dans tout les cas ta fenêtre aura son tableau entier de properties avec des cases vides ou pas
donc tout test if c'est réduit ou pas ou if border ou pas etc sont absolument inutiles
tu fait et c'est tout ;si c’était déjà fait ben ca change rien ça fait rien

 

[Dudu2]

quand tu fait par exemple

iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
SetWindowLongPtr UserFormHandle, GWL_STYLE, iStyle And Not WS_CAPTION

tu peux répéter 20 fois cette opération tu aura toujours le même résultat même si iStyle est différent après la première fois

En ignorant les zéros qui suivent WS_CAPTION c'est &H8 or &H4 (= &HC) soit 1100 en binaire.
Le but c'est bien de mettre à 0 les 2 bits correspondants pour supprimer le Caption avec WS_CAPTION.
S'ils sont déjà à 0 ils y restent, mais ce qui nous intéresse c'est quand ils sont à 1, ils passer à 0.
Je vois pas où est le problème.

donc tout test if c'est réduit ou pas ou if border ou pas etc sont absolument inutiles
tu fait et c'est tout ;si c’était déjà fait ben ca change rien ça fait rien

Pour revenir à la fonction IsBordersAndSystemBarRemoved(), son rôle n'est pas de définir telle ou telle valeur de bits, c'est de retourner True si le Caption est là et False sinon. Elle ne fait rien sur le Caption, ni le retirer, ni l'ajouter, elle teste les bits de WS_BORDER et de WS_DLGFRAME dans le Window Style.

Ce code ne set rien !

    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
    If iStyle = (iStyle And Not WS_DLGFRAME) _
    Or iStyle = (iStyle And Not WS_BORDER) Then
        IsBordersAndSystemBarRemoved = True
    End If

 

[Dudu2]

If iStyle = (iStyle And Not WS_DLGFRAME)

Ce test veut dire que si le Window Style capturé égale le Window Style capturé en retirant le bit de WS_DLGFRAME, alors le Window Style capturé n'a pas le bit de WS_DLGFRAME.

Et donc que le Caption n'est pas là.

 

[Dudu2]

re ben alors tu n'a jamais compris comment ça fonctionnait

Ou alors ça doit être ça !
T'es gonflé quand même !

 

[patricktoulon]

re
c'est pas la valeur ou le contenant c'est l'utilité du test
tu veux l'enlever tu l'enlève (And not)
tu veux le mettre tu le met c'est tout (OR)
il ne peut y avoir d'erreur puisque tu procède en addition logique sur iStyle
istyle est récupéré avec getwindowlong avant
quelque soit la valeur qu'il ai si tu add logiquement ça match
tester si 0 ou 1 est superflu a mon sens

tu utilise des fonction implémenté par ms au travers de ses dll system
pourquoi passer par 1/2/3 fonctions alors que tu obtiens ce que tu cherche par la fonction déjà implémentée par les déclarations d'api ?

si encore c’était un switch automatisé ,je comprendrais

un exemple ou je trouve que c'est justifié par exemple c'est ton GetUserFormHandleByCaption qui là switch sur le findwindowex au cas ou le findwindow donne zero et que peut être le userform a été apparenté a l'app excel
là oui je suis OK
demain je mettrais les test benchmark dessus tes fonctions on analysera les tips pas les temps (quoi que)parce que c'est pas des fonctions lentes mais les tips vont parler à mon avis

 

[patricktoulon]

tiens puisque tu semble adepte des operateurs logiques
teste ca avec un userform et deux boutons

#If VBA7 Then
    #If Win64 Then
         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 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
#End If

Private Sub CommandButton1_Click()
    applique True, False, True
End Sub
Private Sub CommandButton2_Click()
    applique False, True, False
End Sub

Sub applique(Optional reduire As Boolean = False, _
             Optional agrandir As Boolean = False, _
             Optional resizeb As Boolean = False)

    Dim H As LongPtr
    H = FindWindow(vbNullString, Me.Caption)
    SetWindowLongPtr H, -16, &H94C80080 _
                                Or &H20000 And reduire _
                                Or &H10000 And agrandir _
                                Or &H40000 And resizeb
End Sub

 

[Dudu2]

J'ai testé "Removed":

    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
    If iStyle = (iStyle And Not WS_DLGFRAME) _
    Or iStyle = (iStyle And Not WS_BORDER) Then
        IsBordersAndSystemBarRemoved = True
    End If

Mais j'aurais pu tester "Present":

    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
    If CBool(iStyle And WS_DLGFRAME) _
    Or CBool(iStyle And WS_BORDER) Then
        'Return value
        IsBordersAndSystemBarPresent = True
    End If

Dans tous les cas, pour tester la présence ou l'absence d'un bit dans le iStyle, il faut absolument un AND et pas un OR.

 

[Dudu2]

Et ma fonction de mise en place du menu est celle-ci, en utilisant des constantes masques Window Style nommées et documentées par Microsoft dédiées aux options requises et seulement à celles-ci alors que tu forces un Window Style complet indépendamment de ce qu'il est au départ avec cet étrange &H94C80080 nulle part défini, certes la valeur initiale actuelle du Window Style mais qui peut changer dès qu'une nouvelle version d'Excel ajoute ou change un bit d'option. Même si c'est peu probable, ça reste une question de principe.

'--------------------------------------------------------------------------------
'Set minimization / maximization / resize options in the UserForm System Menu Bar
'--------------------------------------------------------------------------------
Sub SetUserFormSystemMenu(UserForm As Object, _
                          Optional XtoClose As Boolean = True, _
                          Optional Minimize As Boolean = False, _
                          Optional Maximize As Boolean = False, _
                          Optional Resize As Boolean = False)
         
    Dim UserFormHandle As Variant
    Dim iStyle As Variant
 
    UserFormHandle = GetUserFormHandleByCaption(UserForm)
    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
 
    'Add or remove the System Menu buttons
    If XtoClose _
    Or Maximize _
    Or Minimize Then iStyle = iStyle Or WS_SYSMENU Else iStyle = iStyle And Not WS_SYSMENU
    If Maximize Then iStyle = iStyle Or WS_MAXIMIZEBOX Else iStyle = iStyle And Not WS_MAXIMIZEBOX
    If Minimize Then iStyle = iStyle Or WS_MINIMIZEBOX Else iStyle = iStyle And Not WS_MINIMIZEBOX
    'With the Resize option, the UserForm keeps its initial margins when the Caption is removed
    If Resize Then iStyle = iStyle Or WS_SIZEBOX Else iStyle = iStyle And Not WS_SIZEBOX
    SetWindowLongPtr UserFormHandle, GWL_STYLE, iStyle
End Sub

Alors certes, tu fais plus court en nombre d'instructions VBA (il faudrait que tu ajoutes le WS_SYSMENU) et pas forcément en instructions exécutées, mais perso je privilégie la lisibilité.

 

[Dudu2]

Pour changer de sujet, j'ai trouvé ça sur stackoverflow.com, un peu arrangé.
Faire d'un Label un faux Caption. Amusant !

 

[patricktoulon]

re
déjà proposé ici

Microsoft 365 - Changement de titre du UserForm

Bonjour, Je souhaite mettre à jour le titre de mon formulaire (en bleu, ou orange par exemple). Sauriez vous comment le faire ? Voici en PJ un fichier test. Merci beaucoup et belle soirée

excel-downloads.com

 

[patricktoulon]

je ne fait pas plus court je procède comme tu semble l’apprécier par addition logique
un autre exemple

#If VBA7 Then
    #If Win64 Then
        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 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
#End If
Private Const WS_DLGFRAME = &H400000
Private Const WS_BORDER = &H800000
Private Const WS_CAPTION = 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 WS_FULLSYSTEM = &H94CF0080
Private Const WS_SYSTEMO = &H94C80080
Private Const GWL_STYLE = -16

Private Sub CommandButton1_Click()
    applique True, True, False, True
End Sub
Private Sub CommandButton2_Click()
    applique True, False, True, False
End Sub

Private Sub CommandButton3_Click()
    applique
End Sub
Private Sub CommandButton5_Click()
    applique False
End Sub

Sub applique(Optional caption As Boolean = True, _
             Optional reduire As Boolean = True, _
             Optional agrandir As Boolean = True, _
             Optional resizeb As Boolean = True)
    Dim H As LongPtr
    H = FindWindow(vbNullString, Me.caption)
    If Not caption Then
        SetWindowLongPtr H, GWL_STYLE, WS_SYSTEMO And Not WS_CAPTION
        Me.Width = Me.Width + 1
        Me.Width = Me.Width - 1
    Else
        SetWindowLongPtr H, GWL_STYLE, WS_FULLSYSTEM _
                   And Not (WS_MINIMIZEBOX And Not reduire) _
                   And Not (WS_MAXIMIZEBOX And Not agrandir) _
                   And Not (WS_SIZEBOX And Not resizeb)
    End If
End Sub




Private Sub CommandButton4_Click()
    Unload Me
End Sub


Private Sub UserForm_Click()

End Sub

si ça c'est pas lisible je ne sais pas ce qu'il te faut
j'ai indenté de cette manière justement pour une compréhension plus facile
clique sur les boutons tu verra tu peux passer d'un mode à lautre sans avoir besoins de tester une propertie ou une autre et encore je suis sur que si je me creuse la tête je peux supprimer le seul if

 

[Dudu2]

C'est parfait !
A part les WS_SYSTEMO et WS_FULLSYSTEM, c'est ton truc pour pas faire de GetWindowLong().

 

[Dudu2]

déjà proposé ici

Ok, tu savais. Je n'ai pas encore lu toutes tes réponse sur le site .

 

[patricktoulon]

C'est parfait !
A part les WS_SYSTEMO et WS_FULLSYSTEM, c'est ton truc pour pas faire de GetWindowLong().

oui c'est vrai mais c'est surtout que pour faire que du And not (retirer une propertie) il faut partir du complet tandis que pour supprimer juste la caption il faut partir de l'original et comme je les connais et qu'il sont universels ben je vais pas m'en priver

tout ça pour te dire qu'avec des additions logiques les codes deviennent plus simples et que surtout ça démontre bien qu'avant d'ajouter ou de supprimer une properties, il n'est pas nécessaire de tester si elle y est déjà