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
 

Dudu2

XLDnaute Barbatruc
essaie mon dernier model sans api et envoie moi une capture
2020-07-30_143601.jpg
 

patricktoulon

XLDnaute Barbatruc
re
on est donc d'accords sans api
pour W10 il faut enlever les ecart car pour W10 l'aero ajoute 1.05 et W7 3.359999....
dommage j'ai pas mon portable W10 sinon je te l'aurais mis au point sans api ;)
car il faut le dire pour une simple maximisation, ça fait un peu usine a gaz

alors qu’après tout api pour Api ben showwindow,handle,3;)
 

Dudu2

XLDnaute Barbatruc
MsgBox Me.Width - Me.InsideWidth me donne 10.80005, on va dire 11.
Suis sur Windows 7 sans Aero (je crois).
Tu veux dire showwindow,handle,3 sur le Handle du UserForm ?
Si on peut le récupérer pourquoi ne pas utiliser cette solution directement alors ?
 

patricktoulon

XLDnaute Barbatruc
a ben sans aéro alors il faut enlever l'ombre qui est de 3.9 ;)
c'est pour ca que je te disais tout a l'heure il y a une api de la dwma.dll a utiliser je me souvient plus la quelle
je retrouverais c'est un exercice que j'ai fait il y a longtemps(2016 ou 2017) sur DVP avec pijaku et unparia
si le cœur t'en dit tu peux chercher avec les 3 pseudos et tu aura un positionnement au pixel près

perso je préférerais que l'on collabore sur ce projet sans api , histoire que cela soit valable au plus grand nombre ;)
 

patricktoulon

XLDnaute Barbatruc
tiens avec ca tout simple je suis bon
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

#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

#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 UserForm_Activate()
    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    ' on remplace le bottom de r1 par le r2.top(top taskbar)
    Me.Move 0, 0, Int(r1.Right / ptopx), Int(r1.Bottom / ptopx)    'et on place le userform
End Sub
 

Dudu2

XLDnaute Barbatruc
En fait, le deal est simple sans API.
Maximiser ?
- Si c'est pour une maximisation totale, on prend les dimensions de l'écran (en pixels), on les convertit en points et l'affaire est réglée.

- Si c'est pour une maximisation quasi-totale qui ne va préserver que la Barre des Tâches, on prend les dimensions de l'écran, on retire la hauteur ou largeur de la Barre des Tâches selon sa position , on les convertit en points et l'affaire est réglée.

En écrivant je vois ton nouveau post dont je regarderai le code un peu plus tard ce soir.
 

patricktoulon

XLDnaute Barbatruc
re
- Si c'est pour une maximisation quasi-totale qui ne va préserver que la Barre des Tâches, on prend les
réfléchi une seconde
sans api a la taille de l’écran c'est inutile car la taskbar prévaut sur l'affichage donc la partie sera caché par la taskbar
non sans api il nous faut absolument se baser sur l'application maximisée
qui elle s’arrête a la taskbar ;)
on a pas d'autre source de dimension sans api ;)
 

youky(BJ)

XLDnaute Barbatruc
Pour ceux que cela intéresse je trouve un meilleur rendu par le zoom.
Je viens de faire un essai avec 2 différentes macros.
Regarder bien les combobox ou case à cocher des listbox selon les macros.
Les ImprimesEcrans dans ce fichier word.
Bruno
 

Pièces jointes

  • ImpEcranZoom.docx
    215.8 KB · Affichages: 18

Dudu2

XLDnaute Barbatruc
Je aussi crois avoir compris pourquoi l'option sur fenêtre Excel maximisée laissait chez toi un petite marge. C'est que ta fenêtre Excel maximisée laissait probablement aussi cette marge.
En déplaçant la barre des tâches j'ai eu ce phénomène car utilisant de petites icônes, le réajustement ne se fait pas et Windows considère que la barre des tâches utilise de grandes icônes...et fait donc apparaître cette petite marge entre les fenêtres maximisées et la barre des tâches.

Je passais par hasard pour autre chose, je regarderai ton code celui de Youki ce soir.
 

modus57

XLDnaute Occasionnel
Bonjour à tous,
Je suis intéressé par cette discussion et + particulièrement par les solutions de youky(BJ)
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
Je rencontre aucun soucis sur un écran de 15" résolution 1366x76 ou 21" résolution 1920x1080, par contre sur ma tablette 12.3" résolution 2736x1824 l'userform de s'adapte pas tsa taille est plus grande que l'écran ?
Avez-vous une solution ?
Merci d'avance pour vos réponse.
 

Dudu2

XLDnaute Barbatruc
tiens avec ca tout simple je suis bon
En effet, tu as bien concentré le truc surtout avec la récupération du RECT de la barre des tâches et ta méthode de conversion PointsToPixels.

Il y a un détail dans l'affichage chez moi qui laisse une faible marge à droite et en bas.
J'avais déjà remarqué que la conversion PointsToPixels que tu utilises donne un résultat légèrement différent de celle que j'utilise. Cette marge se réduit (sans pour autant disparaitre) si on augmente à 10000 le chiffre 100 que tu donnes à PointsToScreenPixelsX.

(ActiveWindow.ActivePane.PointsToScreenPixelsX(100) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 100 -> 1.67
(ActiveWindow.ActivePane.PointsToScreenPixelsX(10000) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 10000 -> 1.6667
(ActiveWindow.ActivePane.PointsToScreenPixelsX(100000) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 100000 -> 1.66667
Le chiffre que je récupère du système est 1.6666666273024
Ces petites décimales font à la fin une différence certes minime, de quelques points, mais réelle.
 

patricktoulon

XLDnaute Barbatruc
re
bonsoir Dudu2
oui en effet on a des décimales un peu différentes
pour mon dernier exemple le principe est simple
j'aime bien les codes simples et clairs
chez moi j'obtiens par le system 1.666666657
tu peux obtenir si tu veux le coeff en lisant le registre
VB:
function PtoPX()as double
PtoPX= CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
end function
 

Discussions similaires

L
Réponses
1
Affichages
1 K
jacquesderyes
J

Statistiques des forums

Discussions
311 721
Messages
2 081 927
Membres
101 842
dernier inscrit
seb0390