Autres Resolution USERFORM et Ecran

FOUQUET Yves

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

VB:
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
 

patricktoulon

XLDnaute Barbatruc
tiens si tu veux faire peter la caption
n'oublie pas de mettre un bouton fermer ;)
VB:
Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

#End If
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type

Function ptopx()    'fonction coeff point to pixel
    With ActiveWindow.ActivePane: ptopx = (.PointsToScreenPixelsX(100) - .PointsToScreenPixelsX(0)) / 100: End With
End Function

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Activate()
    MsgBox GetSystemMetrics(6)
    Dim r1 As RECT, r2 As RECT
    GetWindowRect GetDesktopWindow, r1    'le rectangle de l'ecran
    GetWindowRect FindWindow("shell_traywnd", ""), r2    'le rectangle de la barre des taches
    r1.Bottom = r2.Top + GetSystemMetrics(15) - GetSystemMetrics(5) ' on remplace le bottom de r1 par le r2.top(top taskbar)
    r1.Top = r1.Top - (GetSystemMetrics(15)+  GetSystemMetrics(5))
    'Me.Move 0, 0, Int(r1.Right / ptopx), Int(r1.Bottom / ptopx)    'et on place le userform
    Me.Move 0, r1.Top / ptopx, Int(r1.Right / ptopx), Int(r1.Bottom / ptopx)    'et on place le userform pas de caption

End Sub
 

patricktoulon

XLDnaute Barbatruc
tu en veux une encore plus simple?
pas de soucis
VB:
Option Explicit
#If VBA7 Then
     Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
Function ptopx()    'fonction coeff point to pixel
    With ActiveWindow.ActivePane: ptopx = (.PointsToScreenPixelsX(100000) - .PointsToScreenPixelsX(0)) / 100000: End With
End Function

Private Sub UserForm_Activate()
Me.Move 0, 0, GetSystemMetrics(0) / ptopx, (GetSystemMetrics(1) - GetSystemMetrics(14) - GetSystemMetrics(7)) / ptopx
'Me.Move 0, 0, GetSystemMetrics(0) / ptopx, (GetSystemMetrics(1) / ptopx) - (GetSystemMetrics(21) + GetSystemMetrics(7))
End Sub

j'arrete là sinon demain y a plus de code ;):p:p:p
 

Dudu2

XLDnaute Barbatruc
Bonjour,
Alors là tu chipotes ;)
Reste toujours <Alt + F4> pour se sortir des mauvais pas quand on ne sait plus où on a placé le UserForm :eek:

J'ai finalisé ma version qui est moins concentrée que la tienne et qui donne toujours 3 options de positionnement.
Sans toujours comprendre pourquoi un GetWindowRect GetActiveWindow, R sur une fenêtre maximisée donne des valeurs extravagantes et pas sur une fenêtre réduite (pas minimisée).
Mais bon, pour le 1er cas, il faut limiter par rapport au max de l'écran moins la TaskBar, c'est du moins comme ça que je l'ai mis sous contrôle.

Edit: 20h25 fichier modifié pour utiliser la correction du post #55 pour simplifier. Le résultat est le même.
 

Pièces jointes

  • UserForm maximisé sur tout ou partie de l'écran.xlsm
    53.2 KB · Affichages: 17
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
Bonjour Dudu2
Sans toujours comprendre pourquoi un GetWindowRect GetActiveWindow, R sur une fenêtre maximisée donne des valeurs extravagantes et pas sur une fenêtre réduite (pas minimisée).
j'ai tenté de te l'expliquer mais visiblement je n'y suis pas arrivé
c'est un problème avec Windows 7 thème aero ou basic
une image parlant mieux que milles mots

le même userform, le même fichier, le même jour,la même taille,il y a juste le changement de theme entre les deux capture s
et cela s'applique a tout ce que tu vois a l’écran ;)
c'est pour cela que je t'ai parlé de la dwma.dll et de ces api
demo1.jpg


je regarde ton fichier tout a l'heure je pars en inter dans une demie heure
 

Dudu2

XLDnaute Barbatruc
La fonction RatioOccupationÉcran est un gadget ajouté qui permet de dire par exemple:
"Afficher le UserForm sur la taille de l'écran mais le réduire à 85% par rapport à cette taille."
Edit: j'ai changé le nom en RatioSurDimensionFinale pour (tenter de) clarifier.

test cela en thème basic et aero et regarde bien ou se place le userform
Je sais bien et constate qu'en Aero les entêtes / cadres sont différents.
N.B. je n'ai pas cette légère différence de position constatée sur tes screenshots
Thème Basic:
Usf Basic.jpg


Thème Aero:
Usf Aero.jpg


Mais ça ne justifie en rien que le Left et Top du GetWindowRect GetActiveWindow, r1 soient négatifs sur fenêtre maximisée, et ce dans les 2 modes. Il y a sûrement une raison mais je ne la connais pas. Et ton exemple ne me l'explique pas.

En tous cas, la contre-mesure est simple (voir ci-dessous et avec le fichier joint):
Thème Basic ou Aero:
2020-08-01_223256.jpg
 

Pièces jointes

  • Positions Dimensions Objets.xlsm
    46.6 KB · Affichages: 9
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour Dudu2
non pas du tout ni l'un ni l'autre

tu es le premier a me dire que aero et basic positionne l'uf au bon endroit avec W7
et il y a eu des centaines de tests effectués sur pc différent et tous sans exeption on le même comportement
tu est en dpi 100 ou 120 ?
là tu viens vraiment de me poser une sacré colle ;)car
ton theme basic n'est pas comme chez tout le monde il est pas comme çà normalement
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Bonjour PatrickToulon,
Je ne sais pas trop quoi te dire. Je ne pense ps avoir fait des extravagances avec ces settings que je ne manipule jamais. A part le fond d'écran que j'ai modifié pour ne pas avoir ce logo Windows coloré au beau milieu de l'écran.

Je suis en dpi 120 puisque mon Points To Pixels est 1,666666667.
Sans titre 1.jpg
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
En fait la notion de "correction" n'est pas très judicieuse, il n'y a rien à "corriger".
C'est juste une question de sélection de la partie visible à l'écran qui s'applique à tous les coins du rectangle en toutes circonstances. J'ai corrigé le post #55.
 

Discussions similaires

L
Réponses
1
Affichages
1 K
jacquesderyes
J

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87