Ajuster taille userform en fonction de la resolutionRésolu

Question

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.

28Coco28 · Answer

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

cs_Le Pivert · Answer

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

28Coco28 · Answer

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.

cs_Le Pivert · Answer

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

28Coco28 · Answer

Merci de ton aide, sa fonctionne, super!

ucfoutu · Answer

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

28Coco28 · Answer

je test ça demain au travail est je te redit. merci de ton aide

28Coco28 · Answer

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

ucfoutu · Answer

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

28Coco28 · Answer

oui, je me doute bien, j'ai fermer le fichier, changer la resolution et reouvert le fichier mais fait rien...

28Coco28 · Answer

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?

28Coco28 · Answer

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

ucfoutu · Answer

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

Ajuster taille userform en fonction de la resolution

13 réponses

Votre réponse

Discussions similaires