Ajuster taille userform en fonction de la resolution

[Résolu]
Signaler
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour, je cherche un code qui permet d'ajuster la taille de mes userforms ainsi que leurs contenus a la taille du classeur excel.
j'ai essaye de mettre ce code dans mes userforms, mais je n'ai pas de changements.

Private Sub UserForm_Initialize()
Me.Width = Application.Width
Me.Height = Application.Height
End sub


Quelqu'un a t'il une solution?

PS: dsl pour les fautes d'accents, je suis en Angleterre, et la bas, il n'y a pas d'accent.

13 réponses

Messages postés
7464
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
30 juillet 2021
125
Donc voici un code pour maximiser et minimiser l'userForm. Par contre pour les labels, il faudra voir sur la site que j'ai indiqué précédemment:

Private Declare Function GetWindowLongA Lib "user32" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" _
  (ByVal hwnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long



Private Sub UserForm_Initialize()
 'Maximise et minimise
Dim hwnd As Long
    hwnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) Or &H10000 'maximise
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) Or &H20000 'minimise
End Sub


Le Pivert
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
je viens de trouver ce code, qui correspondrai a peu pres:

Private Sub UserForm_Activate()
ratiow = Application.Width / Me.Width
ratioh = Application.Height / Me.Height
Me.Left = 0
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.FontSize * ratioh
Next
End Sub


Le seul probleme quil me reste est le suivant:
Je ne peux pas le lancer, il me met une erreur
"Run time error'438'
Object doesn't support this property or method"
sur la ligne

"ctl.FontSize = ctl.FontSize * ratioh" et si je la retire il ne change pas la taille de mon texte. De plus sa marche dans le code aue j'ai recupere

Second probleme
j'ai mis une picture dans l'arriere plan de ma userform, elle a les parametres suivants:

Scrollbars=0
ScrollHeight=120
PictureSizeMode=1

Et les boutons, textbox... diminue bien, a part le text(1er probleme) mais l'image ne diminue pas
Messages postés
7464
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
30 juillet 2021
125
Bonjour,
Voir ce site, on peut télécharger un exemple:

http://www.andypope.info/vba/Anchor.htm

C'est très complexe!!!
Bon courage
@+Le Pivert
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
Bonjour,
Merci de ton aide, je suis desoler, mais sa ne correspond pas a ce que je souhaite.
Je voudrais que mes userforms prennent tout l'ecran est qu'elles s'adaptent en fonction de la resolution, tout en adaptant les labels... car elle sont pleine.
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
Merci de ton aide, sa fonctionne, super!
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
Bonjour,

Le tout petit code suivant n'est pas totalement parfait (il ne résout pas exactement tous les problèmes pouvant résulter de proportions différentes, d'un écran à l'autre, entre hauteur et largeur d'écran), mais il devrait largement suffire.

Il te libère par contre totalement des calculs de positionnements et dimensions de tes contrôles ainsi que des calculs des tailles de police

Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long


Private Sub UserForm_Initialize()
  Dim ratio As Double
  ratio = Me.Width / Application.Width
  Me.Zoom = ratio * 100
  DoEvents
  Me.Move 0, 0, GetSystemMetrics(0) / 1.33, GetSystemMetrics(1) / 1.33
End Sub


Le "1.33" est approximatif et correspond à (la très grande majorité aujourd'hui) 15 twips par pixel en hauteur et en largeur.
Si tu préfères un code plus précis (pour calculer très exactement cette valeur), je te l'écris.


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
je test ça demain au travail est je te redit. merci de ton aide
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
Bonjour Ucfoutu,
j'ai essayer ton code, je peux le compiller, mais il ne fonctionne pas...
Lorsque je change de resolution de mon pc, la userform reste avec la taille d'origine
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
j'ai essayer ton code, je peux le compiller, mais il ne fonctionne pas...
Lorsque je change de resolution de mon pc, la userform reste avec la taille d'origine


ce code ne fonctionne pas au moment où tu "changes la résolution de ton pc", mais au moment où tu initialises le userform. C'est à ce moment que les choses se passent, en fonction de la résolution présente !




____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
oui, je me doute bien, j'ai fermer le fichier, changer la resolution et reouvert le fichier mais fait rien...
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
j'ai trouver ce code,
http://www.vbfrance.com//code.aspx?ID=45747
il fonctionne, mais il ne change pas la taille de l'arriere plan de ma userform.
sait tu quel commande je doit ajouter?
Messages postés
24
Date d'inscription
mardi 31 août 2010
Statut
Membre
Dernière intervention
17 mars 2011
1
ca y est, ca fonctionne!
Merci de votre aide et desole d'avoir fait perdre du temps a Ucfoutu

pour mon probleme d'arriere plan, c'etait un paramettre de la userform
PictureSizeMode etait sur 2 et je l'ai passe en 3
est j'ai utiliser le code situe dans le programme sur cette page

http://www.vbfrance.com//code.aspx?ID=45747

Du coup sa fonctionne!
Encore merci a vous
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
Ecoute,
1) mes essais sont chez moi concluants
2) je viens d'apporter une petite modif d'affinement
3) tu auras de meilleurs résultats en donnant à ton userform de départ une forme un peu carrée.

Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long


Private Sub UserForm_Initialize()
  Dim ratio As Double, ratioh As Double, ratiov As Double
  ratioh = GetSystemMetrics(0) \ Me.Width
  ratiov = GetSystemMetrics(1) \ Me.Height
  ratio = IIf(ratioh <= ratiov, ratioh, ratiov)
  Me.Zoom = ratio * 100
  DoEvents
  Me.Move 0, 0, GetSystemMetrics(0) / 1.33, GetSystemMetrics(1) / 1.33
End Sub


Fais donc un petit fichier nouveau et insère un userform de dimensions nettement inférieures (en hauteur et largeur) à celles de ton écran.

Quitte
Choisis ta résolution ===>> ouvre ===>> charge et montre ton userform et constate !


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est