Redimensionnement proportionnel userform/controles

Soyez le premier à donner votre avis sur cette source.

Vue 5 109 fois - Téléchargée 753 fois

Description

Compilation de quelques codes trouvés dans les forums et simplifiés au maximum afin de rendre le redimensionnement des contrôles d'un Userform proportionnel à celui-ci (Même si je pense que mon ratio peut être amélioré). Le tout grâce à la souris comme pour une fenêtre Windows.
Étant un simple novice, mon code vous semblera peut être manquer de professionnalisme mais le but est de donner une base et libre à vous de l'améliorer.

Conclusion :


Vos remarques et commentaires sont les bienvenus !

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
39
Date d'inscription
samedi 30 avril 2011
Statut
Membre
Dernière intervention
26 juin 2012

bonsoir à vous deux,
Je suis ravi de voir que ce poste démontre un certain nombre de possibilités donnant pratiquement le même résultat !
Maintenant, il est vrai que chacun si retrouvera dans tel ou tel code en fonction de ces besoins.
Après avoir un peu potassé tous ces petits codes, je dois avouer que les fonctions de l' API peuvent permettre d'éliminer un grand nombre de lignes ce qui n'est pas négligeable !!
J'ai donc remanié mon code afin d'utilisé l'API et la méthode resize, le résultat en est que plus probant !!
Merci PATOSCH pour tous les compléments apportés sur ce poste, je pense qu'un grand nombre d'utilisateurs seront ravis de tous ces codes sources commentés.
Merci UCFOUTU pour ces nouvelles fonctions que j'ai pu découvrir.
Messages postés
42
Date d'inscription
jeudi 20 septembre 2007
Statut
Membre
Dernière intervention
26 juin 2013

maintenant on peu aussi se servir d'une condition sur le type de controls pour ajouter le font size au redimentionnement

comme ceci:
'userform redimentionable avec les controls redimentionnables
'Createur Patricktoulon
'Date de Creation:26.06.2012
' Pour codesource
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub UserForm_Initialize()
SetWindowLong FindWindow(vbNullString, Me.Caption), -16, GetWindowLong(FindWindow(vbNullString, Me.Caption), -16) Or &H70000
For Each ctrl In Me.Controls
' On se sert du tag pour memoriser les dimension des controls separé par un double point
ctrl.Tag = Me.Height / ctrl.Height & ":" & Me.Width / ctrl.Width & ":" & Me.Width / ctrl.Left & ":" & Me.Height / ctrl.TopIf TypeName(ctrl) "CommandButton" Or TypeName(ctrl) "Label" Or TypeName(ctrl) = "TextBox" Then ctrl.Tag = ctrl.Tag & ":" & Me.Width / ctrl.Font.Size
Next
End Sub
Private Sub UserForm_Resize()
For Each ctrl In Me.Controls
'le tag comporte les diviseurs de l'userform pour obtenir les dimension du control
ctrl.Move Me.Width / Split(ctrl.Tag, ":")(2), Me.Height / Split(ctrl.Tag, ":")(3), Me.Width / Split(ctrl.Tag, ":")(1), Me.Height / Split(ctrl.Tag, ":")(0)If TypeName(ctrl) "CommandButton" Or TypeName(ctrl) "Label" Or TypeName(ctrl) = "TextBox" Then ctrl.Font.Size = Me.Width / Split(ctrl.Tag, ":")(4)
Me.Repaint
Next
End Sub

il est vrai que le code de ucfoutu est beaucoup plus simple mais permet le redimentionnement uniquement par raport au height de l'userform sauf en cliquant sur agrandir tandis que ma version de tort dans tout les sens ce pauvre userform
alors en fait selond les affichage (ecrans 19.6;4.3;1.4) il peut etre interressant d'utiliser une methode ou l'autre

au plaisir
Messages postés
42
Date d'inscription
jeudi 20 septembre 2007
Statut
Membre
Dernière intervention
26 juin 2013

et voila une autre version concernant l'utilisation du tag des controls comme memoire

'userform redimentionable avec les controls redimentionnables
'Createur Patricktoulon
'Date de Creation:26.06.2012
' Pour codesource
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Sub UserForm_Initialize()
SetWindowLong FindWindow(vbNullString, Me.Caption), -16, GetWindowLong(FindWindow(vbNullString, Me.Caption), -16) Or &H70000
For Each ctrl In Me.Controls
' On se sert du tag pour memoriser les dimension des controls separé par un double point
ctrl.Tag = Me.Height / ctrl.Height & ":" & Me.Width / ctrl.Width & ":" & Me.Width / ctrl.Left & ":" & Me.Height / ctrl.Top
Next
End Sub
Private Sub UserForm_Resize()
For Each ctrl In Me.Controls
'le tag comporte les diviseurs de l'userform pour obtenir les dimension du control
ctrl.Move Me.Width / Split(ctrl.Tag, ":")(2), Me.Height / Split(ctrl.Tag, ":")(3), Me.Width / Split(ctrl.Tag, ":")(1), Me.Height / Split(ctrl.Tag, ":")(0)
Me.Repaint
Next
End Sub
maintenant on peut ajouter le font pour le caption ou le texteavec une condition sur le type de control
comme dans mon premier exemple
voila comme tu peut le voir il n'y a rien de compliqué quand au apis il suffit de le savoir et de les comprendres

au plaisir
Messages postés
42
Date d'inscription
jeudi 20 septembre 2007
Statut
Membre
Dernière intervention
26 juin 2013

bonjour a tout les deux

il est vrai qu'avec la propriété zoom on peut reduire serieusement le code comme te l'a dit ucfoutu
parcontre il n'est pas obligé d'utiliser la gestion d'erreurs pour les controls qui n'ont pas la propriété "caption" comme les images par exemple
on peut tout simplement metre un tag au control et s'en servir pour ne faire ou pas les changement dans le resize
j'avais fait un truc du genre sur un autre forum et je viens de le retrouver

regarde un peu ca et effectivement il y a utilisation d'une apis window plus facile a mon gout pour faire ce genre de manipulation sur un userform

'**********************************************************************************************************************
'* CREATEUR :Patricktoulon *
'* DATE :23/09/2010 *
'* UTILISATION D'UNE SEULE API LE "USER32.DLL" *
'* EXEMPLE DE USERFORM REDIMENTIONNABLE NOUVELLE VERSION *
'* LES CONTROLS SONT REDIMENTIONNES EN MEME TEMPS *
'* AINSI QUE LES FONT SIZE *
'**********************************************************************************************************************
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public old_largeur As Long, handle As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single
Public Ctl As MSForms.Control


Sub trois_boutons(uf As UserForm) 'on va ajouter les deux boutons manquants et l'élasticité a l'userform
'***************************************************************
'*ici on memorise les dimention de depart de l'userform * old_largeur uf.InsideWidth: old_hauteur uf.InsideHeight '*
'***************************************************************

'***************************************************************************************************************
' ici on determine le handle par la classe de frame en testant la version de l'application ( DE EXCEL97 A 2007)*
handle = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", uf.Caption) '*
' ici on applique les changement (&h70000= les trois bouton et l'elasticité) *
SetWindowLong handle, -16, GetWindowLong(handle, -16) Or &H70000 '*
'***************************************************************************************************************


End Sub
Sub plein_ecran()
' on affiche le userform en plein ecran avec l'api showwindowa de la user32.dll _
bien moins lourd que mes versions precedente de maximisation de l'userform et plus rapide et plus propre
'1= mode normal
'3 =maximiser
'6 =minimiser
'le handle a été declaré en public au debut du module et _
identifier dans la routine des trois boutons il n'est donc plus necessaire de l'identifier
ShowWindow handle, 3
End Sub

Sub maForm_Resize(usf As UserForm)
'ici on determine le multiplicateur qui differenci la dimention de base a celle actuelle de l'userform newlargeur usf.InsideWidth / old_largeur: newhauteur usf.InsideHeight / old_hauteur

'ici on boucle sur tout les controls
For Each Ctl In usf.Controls
'et on applique le multiplicateur au controls pour la largeur et la hauteur en une seule ligne
Ctl.Move Ctl.Left * newlargeur, Ctl.Top * newhauteur, Ctl.Width * newlargeur, Ctl.Height * newhauteur
' on a pris soin de metre un tag dans les propriétés a tout les controls qui n'ont pas de font size(image,scrollbar ,ect)

'et on applique la formule (userfom.width/ 48) Attention!!! cette valeur peut changer _
pour certaines personnes en fonction de la resolution de leurs ecrans If Ctl.Tag "" Then Ctl.Font.Size (usf.InsideWidth / 48)
Next
'ici on indique que l'ancienne largeur devient la nouvelle largeur et pareil pour la hauteur indispensable pour un futur redimentionnement old_largeur usf.InsideWidth: old_hauteur usf.InsideHeight: usf.Repaint
End Subpar
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
227
Les fonctions de l'API ?
Bof ... elles ne sont là que pour permettre de donner au Userform les mêmes fonctionnalités que celles de toute autre fenêtre Windows (étirement, agrandissement, réduction).
C'est tout (et ne font que remplacer le code qui permet, dans ton exemple, d'étirer).
Ce qui devrait par contre (et quasi uniquement) retenir ton attention, est seulement le code mis dans l'évènement Resize (quel que soit le procédé utilisé en amont pour pouvoir étirer le Userform ! Ce code se contente :
- de déceler l'étirement (au resize, quelle que soit la manière dont il a été obtenu, la lienne ou par API)
- d'utiliser alors tout simplement la propriété Zoom du UserForm !
Afficher les 10 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.