Autres Resolution USERFORM et Ecran

[FOUQUET Yves]

Bonjour,

Quelqu'un peut-il me dire si ces lignes de code me permettront d'adapter sur n'importe quel ordinateur la taille de l'Userform à la résolution de l'écran et la taille de Listbox à la taille de l'Userform ?

Je teste chez moi ça a l'air OK mais sur un écran avec d'autres résolution ???

Merci de vos réponses.
Bonne soirée.

LargeurEcran = GetSystemMetrics(0)
HauteurEcran = GetSystemMetrics(1)
HauteurUserf = HauteurEcran * 0.75
LargeurUserf = LargeurEcran * 0.75
Me.Move 1, 1, LargeurUserf, HauteurUserf  'pour tout modifier
ListBox1.Width = LargeurEcran * 0.74
ListBox1.Height = HauteurEcran * 0.62

 

[youky(BJ)]

Bonsoir Yves,
Voici une solution
Bruno

Private Sub UserForm_Initialize()
Dim ctl As Control
Dim ratow As String
Dim ratioh As String
On Error Resume Next
ratiow = Application.Width / Me.Width
ratioh = Application.Height / Me.Height
Me.Left = -6
Me.Top = 0
Me.Width = Application.Width
Me.Height = Application.Height
For Each ctl In Me.Controls
  ctl.Left = ctl.Left * ratiow
  ctl.Top = ctl.Top * ratioh
  ctl.Width = ctl.Width * ratiow
  ctl.Height = ctl.Height * ratioh
  ctl.FontSize = ctl.Font.Size * ratioh
Next
End Sub

 

[Dudu2]

Bonjour,
Les dimensions écran sont données en Pixels.
Les Objets Excel utilisent des tailles et positions en Points.
Les positions en points sont relatives à leurs parents.
Pour les UserForms c'est la fenêtre, pour les objets (ListBox...) à l'intérieur c'est le Userform.

Sur mon écran:

 

[FOUQUET Yves]

Désolé mais cela ne fonctionne pas...

Private Sub UserForm_initialize()
Dim ctl As Control
Dim ratiow As String
Dim ratioh As String
On Error Resume Next
ratiow = Application.Width / Me.Width
ratioh = Application.Height / Me.Height
Me.Left = -6
Me.Top = 0
Me.Width = Application.Width
Me.Height = Application.Height
For Each ctl In Me.Controls
  ctl.Left = ctl.Left * ratiow
  ctl.Top = ctl.Top * ratioh
  ctl.Width = ctl.Width * ratiow
  ctl.Height = ctl.Height * ratioh
  ctl.FontSize = ctl.Font.Size * ratioh
Next

nomfichier = UserForm1.chemin2 & "\Donnees.xlsm"
Set Ws = Workbooks.Open(nomfichier).Sheets("Projet")

Application.DisplayFullScreen = True
Application.WindowState = xlNormal

Set Ws = Sheets("Projet")
    With Sheets("Projet")
    Set Rng = .Range("A2:Z" & Ws.[B60000].End(xlUp).Row)
    End With
    ListBox1.ColumnCount = 30
    ListBox1.ColumnWidths = "20;160;80;80;80;80;80;80;80;80;80;80;80;;80;80;80;80;80;80;80;"
    ListBox1.RowSource = Rng.Address(external:=True)
End Sub

La fenêtre est moitie de l'écran....

 

[Dudu2]

Un exemple de UserForm plein écran.
Pour adapter à une fraction d'écran il suffit d'appliquer un ratio sur les dimensions hauteur et largeur.

 

[Dudu2]

Je viens d'ajouter un ratio d'occupation d'écran pour le UserForm en constante à adapter selon les besoins.

 

[FOUQUET Yves]

Avec ceci cela a l'air cohérent.
La remarque de Dudu m'a conduit à cela..
Les positions en points sont relatives à leurs parents.
Pour les UserForms c'est la fenêtre, pour les objets (ListBox...) à l'intérieur c'est le Userform.

LargeurEcran = GetSystemMetrics(0)
HauteurEcran = GetSystemMetrics(1)
HauteurUserf = HauteurEcran * 0.75
LargeurUserf = LargeurEcran * 0.75
Me.Move 1, 1, LargeurUserf, HauteurUserf  'pour tout modifier
ListBox1.Width = LargeurUserf * 0.98
ListBox1.Height = HauteurUserf * 0.85

 

[youky(BJ)]

Je viens de faire un fichier et ca fonctionne très bien
Bruno

 

[FOUQUET Yves]

Regardez ceci et lancez Userform2 à partir de VBA.

 

[FOUQUET Yves]

'Correspond au programme du bouton QUITTER
Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
LargeurEcran = GetSystemMetrics(0)
HauteurEcran = GetSystemMetrics(1)
  TextBox1.Value = HauteurEcran
  TextBox2.Value = LargeurEcran
 
  HauteurUserf = HauteurEcran * 0.75
  LargeurUserf = LargeurEcran * 0.75
  TextBox3.Value = HauteurUserf
  TextBox4.Value = LargeurUserf
  TextBox5.Value = HauteurUserf * 0.95
  TextBox6.Value = LargeurUserf * 0.72
 
  Repaint
 

Me.Move 3, 3, LargeurUserf, HauteurUserf  'pour tout modifier
LargeurEcran = GetSystemMetrics(0)
HauteurEcran = GetSystemMetrics(1)
HauteurUserf = HauteurEcran * 0.75
LargeurUserf = LargeurEcran * 0.75
Me.Move 1, 1, LargeurUserf, HauteurUserf  'pour tout modifier
ListBox1.Width = LargeurUserf * 0.95
ListBox1.Height = HauteurUserf * 0.72
End Sub

 

[youky(BJ)]

Voici comme moi je procède...
L'user est en plein écran selon le ratio de largeur et selon le ratio de hauteur
ainsi que tout les contrôles
Bruno

 

[FOUQUET Yves]

OK et un grand merci pour votre aide.
Bonne fin de soirée.
Yves

 

[patricktoulon]

bonsoir
c'est pas bien au point tout ça

1. et si l'application n'est pas maximized(choux blanc)😵
2. si l'userform est plus large que haut ou l'inverse pour le font size ratiow ou rationh ??????
3. ratioW as string ratioh as string heu......?????????????? 😵
4. et si les control tel qu'un progressbar ou un spinbutton et quelques autres qui n'ont pas de membre font comment on fait????😵
5. le on error resume next en debut de sub si erreur pendant la boucle ben le reste est zapé 😵

j'aurais fait comme suit
et c'est valable dans toute les conditions

Private Sub UserForm_Initialize()
    Usf_resize
End Sub
Private Sub Usf_resize()
    Dim ctrl As Control, RatioW#, RatioH#, Ratio_fSize, W&, T&, L&, H&, Wstate&
    With Application
        Wstate = .WindowState
        .WindowState = xlMaximized
        W = .Width: H = .Height: L = .Left: T = .Top
        RatioW = W / Me.Width: RatioH = H / Me.Height
        Ratio_fSize = .Min(RatioH, RatioW)
        .WindowState = Wstate
    End With
   
    Me.Move L, T, W, H

    For Each ctrl In Me.Controls
        ctrl.Move ctrl.Left * RatioW, ctrl.Top * RatioH, ctrl.Width * RatioW, ctrl.Height * RatioH
        On Error Resume Next    'tout les control msforms.... n'ont pas la membre [B]font [/B]et ses propriétés
        ctrl.FontSize = ctrl.Font.Size * Ratio_fSize
        Err.Clear
    Next
End Sub

ci joint le fichier avec ton userform "Le_bon" et 2 autres(vertical et horizontal) qui démontrent le problème d'utiliser le ratioh ou ratiow pour les fonts selon la forme du userform de départ
😉

 

[Dudu2]

Bonjour à tous,

Excellent code de Patrick.
Il y a cependant une chose que je n'ai jamais comprise dans les coordonnées en points de Application.L/W/T/H qu'on retrouve (pas de la même façon !) dans les coordonnées en pixels de GetWindowRect, ce sont ces dépassements qui apparaissent dans le UserForm généré basé sur Application.L/W/T/H.

En fait, le seul retour correct que j'ai pu obtenir est le celui du GetClientRect en pixels (à convertir en points pour les objets points).

 

[Dudu2]

Ce qui, en utilisant le code de Patrick, additionné de fonctions de conversion PixelsToPoints et d'un ratio d'occupation d'écran donne ça...