REDIMENSIONNEMENT PROPORTIONNEL USERFORM/CONTROLES
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
24 juin 2012 à 11:58
boomer11 Messages postés 39 Date d'inscription samedi 30 avril 2011 Statut Membre Dernière intervention 26 juin 2012 - 26 juin 2012 à 23:00
boomer11 Messages postés 39 Date d'inscription samedi 30 avril 2011 Statut Membre Dernière intervention 26 juin 2012 - 26 juin 2012 à 23:00
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/54405-redimensionnement-proportionnel-userform-controles
https://codes-sources.commentcamarche.net/source/54405-redimensionnement-proportionnel-userform-controles
26 juin 2012 à 23:00
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.
26 juin 2012 à 16:21
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
26 juin 2012 à 15:46
'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
26 juin 2012 à 14:42
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
26 juin 2012 à 11:29
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 !
25 juin 2012 à 23:25
Je viens de prendre connaissance de votre code, et effectivement, il est bien plus simplifié en nombre de lignes mais un peu plus complexe en déclaration (fonction API).
Malheureusement mon auto-formation ne m'a pas encore emmené vers ce chemin là pour l'instant !
Par conséquent la méthode zoom semble donner un meilleur rendu, et solutionne effectivement les problèmes liés entre autre aux polices.
Cependant, je tiens quand même à préciser que l'on peut mettre tous ces contrôles sur mon userform sans changer de code :
Label / Textbox / Combobox / Listbox / Checkbox / OptionButton / Togglebutton / Spinbutton / Scrollbar / CommandButton / Picturebox / Frame / Multipage / Contrôle Onglet
En tout cas merci pour toutes ces explications, je pense voir les choses autrement maintenant et j’espère que pour d'autres aussi.
25 juin 2012 à 07:46
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 usf_width As Long, usf_height As Long, k As Single
Private Sub UserForm_Initialize()
Dim iStyle As Long, hwnd As Long
hwnd = FindWindow(vbNullString, Me.Caption)
iStyle = GetWindowLong(hwnd, -16) Or &H70000
SetWindowLong hwnd, -16, iStyle
k = Me.Width / Me.Height
usf_width = Me.Width
End Sub
Private Sub UserForm_Resize()
On Error Resume Next
Me.Width = Me.Height * k
Me.Zoom = (Me.Width / usf_width) * 100
End Sub
Et aucun autre code.
Même une imagebox (et même avec sa propriété autosize à False) "suit" convenablement. Et pas de problèmes avec les polices de caractères.
Et on ne modifie pas, dans les étirements, les proportions du UserForm.
Pour étirer : le faire comme on le fait avec toute fenêtre Windows (à partir de son contour).
Essaye et tu vas comprendre.
25 juin 2012 à 07:07
"Avec tous les contrôles de la boite à outils d'un formulaire simple de userform, normalement sans aucune erreur et sans l'emploi de "On Error Resume Next" ?
Non ==>> uniquement avec ceux possédant une propriété caption, sauf à ajouter une gestion d'erreur ou des lignes d'expressions conditionnelles.
24 juin 2012 à 15:09
Ce Code fonctionne avec tous les contrôles de la boite à outils d'un formulaire simple de userform, normalement sans aucune erreur et sans l'emploi de "On Error Resume Next".
Je vous invite à l'essayer sur le fichier téléchargeable.
Mais, comme je l'ai dit ce code reste une base à adapter au besoin de l'utilisateur!
En revanche, je retiens votre proposition pour effectivement améliorer la proportionnalité des contrôles! (Peut être un futur code à poster)
Merci pour les commentaires, il me permettent d'avancer !!!
24 juin 2012 à 11:58
Ce genre de "resizer" ne sera jamais sans failles diverses (adaptation réelle des tailles de police, etc ...)
Il vaut alors bien mieux se servir plus simplement de la propriété zoom de l'userform.
Regarde déjà (et entre autres) ce qui se passerait en ajoutant un tout bête contrôle UpDown sur le Userform !
Il va te falloir "bourrer" ton code de "On Error Resume Next" ou de gestions similaires dans un très grand nombre de cas de figure !