Microsoft 365 UserForm maximiser la taille du formulaire par rapport à la taille de l'écran

[Fab117]

Hello,
Les dimensions de mon User form tel que je l'ai créé sont :

Je voudrais maximiser sa taille lorsqu'il apparait à l'écran.
Google ne m'a pas permis de faire ça simplement => mon idée était :
1. Récupérer la dimension de l'écran utilisé (j'ai trouvé la function et le code VBA associé

Declare PtrSafe Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Sub ScreenResolution()
Dim wS As Long, hS As Long
    wS = GetSystemMetrics32(0) ' width in points
    hS = GetSystemMetrics32(1) ' height in points
    MsgBox ("hauteur : " & hS & Chr$(10) & "largeur : " & wS)
End Sub

2. Via un "If", maximiser le coté (haiuteur ou largeur) non limitant

' Dimensions du UserForm
If wS / hS > 1.291139 Then ' Cas où la limitation du formulaire sera sur sa hauteur
    Me.Height = hS
    Me.Width = hS * 1.291139
Else ' Cas où la limitation du formulaire sera sur sa largeur
    Me.Width = wS
    Me.Height = wS / 1.291139
End If

Problème, lorsque je mets la déclaration de la fonction dans le code du UserForm :

il n'accepte pas :

Quelqu'un saurait-il comment résoudre ce problème ?

Merci par avance et excellente soirée.

Fab

 

[Fab117]

En publiant ce message, Excel-Download m'a proposé des sujets similaires.
En testant le fichier proposé par @Modeste geedee (lien), je pense avoir trouvé la solution à mon problème :

Private Sub UserForm_Initialize()

' Dimensions de l'écran
Dim wS As Long, hS As Long
    'wS = GetSystemMetrics32(0) ' width in points
    'hS = GetSystemMetrics32(1) ' height in points
    wS = Application.Width ' width in points
    hS = Application.Height ' height in points

' Dimensions du UserForm
If wS / hS > 1.291139 Then ' Cas où la limitation du formulaire sera sur sa hauteur
    Me.Height = hS
    Me.Width = hS * 1.291139
Else ' Cas où la limitation du formulaire sera sur sa largeur
    Me.Width = wS
    Me.Height = wS / 1.291139
    
End If

 

[patricktoulon]

bonjour
compatible all office et all window
version 1

'**********************************************************************************************
'          Utilisisation des api sans déclaration avec les macro4
'                 appliquer un mode d'affichage a l'userform
'patricktoulon
'
'SW_HIDE            0 Cache la fenêtre et en active une autre.
'SW_MAXIMIZE        3 Agrandit la fenêtre.
'SW_MINIMIZE        6 Réduit la fenêtre et active la prochaine (dans l'ordre des tâches windows).
'SW_RESTORE         9 Active et affiche la fenêtre à sa taille et position initiales.
'SW_SHOW            5 Active et affiche la fenêtre.
'SW_SHOWMAXIMIZED   3 Active et agrandit la fenêtre.
'SW_SHOWMINIMIZED   2 Active et réduit la fenêtre.
'SW_SHOWNA          8 Identique à SW_SHOW sauf que la fenêtre n'est pas activée.
'**********************************************************************************************

'EXEMPLE show full screen
Private Sub UserForm_Activate()
    FullScreen 3
End Sub

Private Sub FullScreen(mode)
    Dim hwnd&
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow Capture du handle de la fenetre active
    ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ"",""" & hwnd & """,""" & mode & """)")    ' application du mode
    ' et si tu veux les trois bouton debloque la ligne ci dessous
    'ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94CF0080 & ")")     'api SetWindowLongA
End Sub

version2 avec zoom extrapolé sur deux axes(hauteur/largeur)

Option Explicit
Function ptopx()    'fonction coeff point to pixel
   Dim z#
   With ActiveWindow.Panes(1): z = .Parent.Zoom / 100: ptopx = (.PointsToScreenPixelsX(72 * z) - .PointsToScreenPixelsX(0)) / 72: End With
End Function

Private Sub UserForm_Activate()
    Dim W#, H#, capt#, border#, UFW#, UFH#, ratw#, rath#, ratfontSize&, ctrl
    UFW = Me.Width: UFH = Me.Height
    W = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 0 & ")") / ptopx
    H = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 1 & ")") / ptopx
    capt = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 14 & ")") / ptopx
    border = ExecuteExcel4Macro("CALL(""user32"",""GetSystemMetrics"",""jjj""," & 32 & ")") / ptopx
    Me.Move 0, 0, W, H - capt - border
    ratw = Me.Width / UFW: rath = Me.Height / UFH
    ratfontSize& = Application.Min(ratw, rath)
    For Each ctrl In Me.Controls
        With ctrl: .Move .Left * ratw, .Top * rath, .Width * ratw, .Height * rath:
        On Error Resume Next
        .Font.Size = .Font.Size * ratfontSize
        Err.Clear
        End With
    Next
End Sub

 

[Fab117]

Salut Patrick,
Merci beaucoup d'avoir pris le temps de regarder mon problème.

Tout d'abord, avec ma méthode, ça ne fonctionne pas terrible. Le userForm prend bien les dimensions rechechées, mais la taille du contenu ne s'adapte pas. Je me retrouve donc avec beaucoup de vide

J'ai essayé d'appliquer ta version 1.
Mais je dois faire quelque chose de faux, car je ne vois pas de différence avec ou sans.
Avec :

Sans :

 

[patricktoulon]

re
regarde bien
voila comment est mon userform dans le VBE

et revoila le même affiché

c'est du prêt à porter
je te donne un fichier exemple

 

[Dranreb]

Bonsoir.
Il suffit d'ajouter Private devant les instructions Declare.

 

[Fab117]

Hello,
Non seulement ça fonctionne, mais en plus tu résouds mon autre problème de mettre tous les champs à l'échelle.
Parfait.

Merci beaucoup

Merci également à Dranreb d'avoir pris le temps de regarder mon problème.

Très belle fin de journée à vous deux

 

[patricktoulon]

 

[Fab117]

Hello @patricktoulon

Je recontres un soucis :

Parfois, lorsque j'initialise le formulaire, il occupe bien tout l'écran, mais il apparait tronqué (il manque la partie basse/droite).


Lorsque je vais l'éditeur VBA et que je regarde le UserForm, il est entièrement visible, mais relativement petit.

Pour résoudre ceci, il faut que j'étire le UserForm depuis le coin en bas à droite.

Dès que je commence à étirer, il reprend sa dimension normale :

Je=> je l'étire jusqu'à le voir dans sa totalité :

Je pense avoir trouvé une des causes de ce soucis :

Je travaille sur un laptop en écran principal (1920 x 1080) avec un écran secondaire (2560 x 1440) en bureau étendu.

Si je clone les 2 écrans (=> même résolution sur les 2), pas de soucis.



Saurais-tu s'il est possible de résoudre ce problème ?



Bonne fin de journée.



Fab

 

[patricktoulon]

re
Bonjour
c'est vrai qu'avec 2 écrans ça a toujours été un problème
sachant que la détection est faite sur le monitor principal c'est difficile en plus selon le mode (clone/étendu/etc...) le raisonnement est différent
il existent des astuces avec encore plus d'api et des pirouettes mais rien de vraiment solide

 

[Modeste geedee]

Hello @patricktoulon

Je recontres un soucis :

Parfois, lorsque j'initialise le formulaire, il occupe bien tout l'écran, mais il apparait tronqué (il manque la partie basse/droite).


Lorsque je vais l'éditeur VBA et que je regarde le UserForm, il est entièrement visible, mais relativement petit.
Regarde la pièce jointe 1169877


Pour résoudre ceci, il faut que j'étire le UserForm depuis le coin en bas à droite.

Dès que je commence à étirer, il reprend sa dimension normale :
Regarde la pièce jointe 1169879


Je=> je l'étire jusqu'à le voir dans sa totalité :

Regarde la pièce jointe 1169880
Je pense avoir trouvé une des causes de ce soucis :
Je travaille sur un laptop en écran principal (1920 x 1080) avec un écran secondaire (2560 x 1440) en bureau étendu.
Si je clone les 2 écrans (=> même résolution sur les 2), pas de soucis.
Saurais-tu s'il est possible de résoudre ce problème ?
Bonne fin de journée.
Fab

Bonjour,
A partir des propriétés du userform
1 - Mémoriser dans le code les dimensions width et height utilisées pour la conception
2 - modifier la propriété zoom
3 - dans le code userform-activate, actualiser les propriétés width et height relativement au ratio zoom
Je fournirai un exemple lorsque j'accéderai à mon PC

 

[patricktoulon]

bonjour @Modeste geedee
c'est le principe que j'utilise déjà dans la version dynamique
seul probleme c'est quand tu es en double affichage ça ne répond plus correctement

et le zoom ne peut qu'avoir qu'un seul coefficient

sinon il y a la version dynamique
@Fab117 quand on cherche on trouve

edit :je viens de tester en double affichage en clone ça marche très bien
soit tu oublie un épisode soit tu t'explique mal

 

[TooFatBoy]

Bonjour,

edit :je viens de tester en double affichage en clone ça marche très bien
soit tu oublie un épisode soit tu t'explique mal

C'est aussi ce qu'il a dit :

Si je clone les 2 écrans (=> même résolution sur les 2), pas de soucis.

 

[patricktoulon]

re
bonjour

Je travaille sur un laptop en écran principal (1920 x 1080) avec un écran secondaire (2560 x 1440) en bureau étendu.

comme je l'ai dis plus haut en mode étendu il faut travailler autrement
et c'est pas de la tarte car ce sera vraiment une config locale qu'il faudra revoir sur chaque pc utilisant le fichier
pour moi ça vaut pas le coup

 

[Fab117]

Hello,

Merci à vous deux (@patricktoulon & @TooFatBoy) de passer du temps sur ma problématique.

Je comprends que l'utilisation du mode étendu n'est pas adapté à ce code et qu'il serait très compliqué d'obtenir une solution satisfaisante => pas de problème, l'utilisation du fichier se fera en mode Clone.

Par contre, j'ai pas mal d'utilisateurs qui vont utiliser ce fichier => je peux bien sûr mettre une MsgBox à l'ouverture du fichier pour préciser que le mode étendu ne doit pas être utiliser.

Mais à coup sûr mon téléphone va sonner pliusieurs fois par jour, car des utilisateurs n'auront pas respecter la consigne => ils auront provoqué le redimentionnement du UserForm dans l'éditeur VBA et auront sauver le fichier. => je devrais intervenir pour redimentionner le UserForm dans l'éditeur VBA et resauver le fichier,

=> Existe-il une possibilité (à l'ouverture du fichier) d'identifier une configuartion mode étendue ?

Dans ce cas, je pourrais mettre ma MsgBox et je referme le fichier sans le sauver

Bon après-midi

Fab