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)]

Bonjour tous,
Pouquoi ne ne pas utiliser le zoom
De plus c'est Excel qui gère
1ère macro plein écran
2ème se mets selon la taille de l'application

Bruno

Private Sub UserForm_Initialize()
'plein écran
With Application
        Wstate = .WindowState
        .WindowState = xlMaximized
        ratiow = Int(.Width * 100 / Me.Width)
        ratioh = Int(.Height * 100 / Me.Height)
        ratio = IIf(ratiow < ratioh, ratiow, ratioh)
   Me.Zoom = ratio
   Me.Left = -6
   Me.Top = 0
   Me.Width = Application.Width
   Me.Height = Application.Height
       .WindowState = Wstate
  End With
End Sub

et taille idem application

Private Sub UserForm_Initialize()
'taille selon application
With Application
        ratiow = Int(.Width * 100 / Me.Width)
        ratioh = Int(.Height * 100 / Me.Height)
        ratio = IIf(ratiow < ratioh, ratiow, ratioh)
        Me.Zoom = ratio
Me.Left = Application.Left
Me.Top = Application.Top
Me.Width = Application.Width
Me.Height = Application.Height
End With
End Sub

 

[patricktoulon]

bonjour youky(BJ)
avec zoom ça ne peut pas être proportionnel en hauteur et en largeur
cela dit c'est une solution simple tout dépend du besoins

Dudu2 je regarde ton fichier j'avoue ne pas trop comprendre ce que tu cherche a faire

 

[Dudu2]

j'avoue ne pas trop comprendre ce que tu cherche a faire

Tu ne me comprends jamais

. Mais c'est parce que tu ne lis pas vraiment pas les messages.

Je cherche à dimensionner le UserForm sur la zone écran désirée avec précision.
Or, les coordonnées obtenues avec Application.L/W/T/H ne le permettent pas !

Pour t'en convaincre, affiche le UserForm avec ton fichier, et à coté, affiche-le avec mon fichier.
Tu constateras que l'affichage n'est pas identique.

 

[patricktoulon]

re
je suis pas bon avec ton fichier
trop large et pas au top

 

[Dudu2]

Sur des captures plein écran...

Je ne suis pas bon avec ton fichier qui déborde à droite et en bas:

Quand le mien cadre parfaitement la zone ciblée (on perçoit les marges bleues du UserForm):

 

[patricktoulon]

re
teste ça dans un module

Option Explicit
#If VBA7 Then
     Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
     Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function GetDesktopWindow Lib "user32" () As Long
#End If
'Type Retactangle

Private Type RECT
    gauche As Long
    haut As Long
    droite As Long
    bas As Long
End Type
Dim r As RECT

Function GetRectangleScreen()
    GetClientRect GetDesktopWindow, r
End Function

Public Function PixelToPoint() As Double
    With ActiveWindow.ActivePane
        PixelToPoint = (.PointsToScreenPixelsX(100) - .PointsToScreenPixelsX(0)) / 100
    End With
End Function

Sub test()
    Dim Enpixel, Enpoint, texte$
    GetRectangleScreen
     Enpixel = Array(r.gauche, r.haut, r.droite - r.gauche, r.bas - r.haut)
    Enpoint = Array(r.gauche, r.haut, (r.droite / PixelToPoint), (r.bas / PixelToPoint))

    texte = "les dimensions en pixel  de l'écran sont " & Enpixel(2) & " X " & Enpixel(3)
    texte = texte & vbCrLf & "en points ca donne " & Enpoint(2) & " X " & Enpoint(3)

    MsgBox texte

End Sub

 

[patricktoulon]

ton model chez moi
pas en top 0
trop petit en height

 

[patricktoulon]

voici un model chez moi qui m'affiche l'userform sans tronquer les bordures
ce qu'il faut retenir c'est que selon le system (W7/W+) il y a l'aero qui ne fonctionne pas pareil sur (W8,W10) et W7
donc sans api il faut relever + ou moins
donc dans tes calcul et les miens il faut ajouter les conditions operating system et application version

ce model directement fait pour 2007 et ou W7(aero)

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&, ecartX&, ecartY&
    ecartX = Round(Me.Width - Me.InsideWidth, 0)
    ecartY = Round(Me.Height - Me.InsideHeight, 0)
    With Application
        Wstate = .WindowState
        .WindowState = xlMaximized
        W = .Width - ecartY: H = (.Height + ecartX) - ecartY: 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

ecarty correspond a la largeur d'une scrollbar ou la hauteur d'une caption
ecartX correspond a l’épaisseur du cadre
a mettre ou non selon la version
il existe bien entendu une api pour faire correspondre ton model chez moi qui prend en charge l'aero

 

[Dudu2]

Ok, mais si tu réduis de l'épaisseur du cadre (ecartX = Round(Me.Width - Me.InsideWidth, 0) / ecartY = Round(Me.Height - Me.InsideHeight, 0)) et que ça marche n'est-ce pas là pur hasard ?
Car je ne vois pas pourquoi la différence entre les Application.WxH (chez moi en pixels 1938 x 1064) et ClientRect.WxH (1920 x 1046) serait liée à des épaisseurs de marges de UserForm.

 

[patricktoulon]

re
a tu essayé getwindowrect a la place de GetClientRect
c'est bizarre chez moi l'api donne bien 1600 X1024 et c'est identique a la résolution
encore des bizarrerie W10 essaie avec l'autre api

 

[Dudu2]

Pour comprendre que "mon" modèle est trop court en hauteur chez toi, il faudrait que j'ai le même environnement. Mais là c'est difficile sans voir les valeurs retournées par GetClientRect.

Je peux faire un essai en corrigeant la hauteur en prenant jusqu'à la TaskBar (en supposant qu'elle est en bas dans un 1er temps)

 

[patricktoulon]

essaie mon dernier model sans api et envoie moi une capture

 

[Dudu2]

GetWindowRect me donne aussi des chiffres étranges.

 

[Dudu2]

Cette version a 2 options de compilation dont celle précédente se basant sur le GetClienRect et celle ajoutée et active se basant sur la TaskBar (supposée présente en bas).
Juste pour voir ce que ça donne.

 

[patricktoulon]

re
1064-1055=16
ptopix en DPI 100% donc (96)= 1.333333333333333 soit (4/3)
ptopix en DPI 120% donc (125)= 1.666666666657 soit 1.333333333333333 X (120/100)

donc chez toi
voyons voir
16/ptopix =12 point :soit (l’épaisseur de bordure d'un coté *2) =6

quand l'application est maximisée elle est a -3,3599957 points de left et à peu près pareil pour le top

voyons voir
-9/ptopx=-6.75 soit -6.75 / 2=-3.36 ben c'est bien ca a deux poils de C.. de mouches près

c'est légèrement inférieur pour le vertical le pointperinch horizontal 88 vertical 90 me semble t il
pour le top c'est a peu prés -3.05

comme un point c'est un point (un entier) et ne se divise pas comme un pixel d'ailleurs ben c'est 3