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...