[XL-2002] Rendre un Userform Redimensionnable par l'utilisateur et ajouter des scrollbars

Rendre un Userform Redimensionnable par l'utilisateur et ajouter des scrollbars

Bonjour,

Je cherche un code permettant de rendre un Userform redimensionnable par l'utilisateur et d'ajouter des scrollbars.

Merci

Bonsoir,
Je ne sais pas comment tu souhaites redimensionner le UserForm mais voici un petit exemple d'un UserForm dont la largeur est dimensionnée à 240 et ayant un control ScrollBar qui peut changer la largeur de 240 à 1000
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub ScrollBar1_Change() Me.TextBox1 = Me.ScrollBar1.Value Me.Width = Me.ScrollBar1.Value End Sub Private Sub UserForm_Initialize() With Me.ScrollBar1 .Min = 240: .Max = 1000 .SmallChange = 10: .LargeChange = 100 End With End Sub

heu

bonjour

pour redimentionner dynammiquement un usf tu peu utiliser les apis

regarde "ICI"
au plaisir

Merci pour vos réponses mais ce n'est pas exactement ce que je cherche. Je un moyen de rendre le userform redimensionnable par l'utilisateur, mais sans que les contrôles ce redimensionnent. Je veux aussi que des scrollbars s'ajoutent au besoin. Un peut comme le fonctionnement d'IE quand il n'est pas plein écran.

Merci

re

bonsoir

non de dieu de non de dieu!!!!

j'ai vu développeur dans ton profil alors j'ai pas jugé utile de te dire qu'il n'était pas nécessaire de recopier tout le code dans le lien concernant ma contribution

alors un exemple comme ça vite fait et parfaitement fonctionnel:

dans le module du userform tu met ça !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Dim heightscroll As Long
Dim Widthscroll As Long
Private Sub UserForm_Activate()
'ici on apelle la macro qui va ajouté les propriété identique aux autre type de fenetre
trois_boutons Me
'maintenant que l'on a l'elasticité et les deux boutons manquants on va trouver la mesure des scroll bar
' pour cela on va tout simplement boucler sur tout les controls de l'usf en prenant en compte leur  topet leur height
' et on gardera le plus grand pour chaque scrollbars
For Each ctrl In Me.Controls
If ctrl.Top + ctrl.Height > heightscroll Then heightscroll = ctrl.Top + ctrl.Height
If ctrl.Left + ctrl.Width > Widthscroll Then Widthscroll = ctrl.Left + ctrl.Width
 
Next
Me.ScrollHeight = heightscroll
Me.ScrollWidth = Widthscroll
'voila maintenant on a la taille des scrollbars
End Sub
 
 
 
Private Sub UserForm_Resize()
'maintenant on les afiche ou pas en fonction de la largeur et hauteur du usf
'si la hauteur et la largeur  de l'usf est plus grande que le plus bas des controls alors on met les deux scrollbars
If Me.Height < heightscroll + 20 And Me.Width < Widthscroll + 20 Then Me.ScrollBars = 3
'si la hauteur estplus petite mais la largeur plus grande que le plus a gauche des controls alors on met que la verticale
If Me.Height < heightscroll + 20 And Me.Width > Widthscroll + 20 Then Me.ScrollBars = 2
'si la hauteur est plus grande mais la largeur plus petite que le plus a gauche des controls alors on met que l'horizontale
If Me.Height > heightscroll + 20 And Me.Width < Widthscroll + 20 Then Me.ScrollBars = 1
End Sub
'voila merci les apis youpi tralala

maintenant dans un module standard tu met ca !!:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
'**********************************************************************************************************************
'*                                     CREATEUR :Patricktoulon                                *
'*                                                    DATE :23/09/2010                                                *
'*                                       UTILISATION D'UNE SEULE API LE "USER32.DLL"                                  *
'*                                    EXEMPLE DE USERFORM REDIMENTIONNABLE NOUVELLE VERSION                           *
'*
'**********************************************************************************************************************
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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
 
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 &HC70000                                            '*
 '***************************************************************************************************************
 End Sub

voila j'espere ne pas t'avoir trop maché le travail:mouarf::mouarf:

au plaisir

Merci sa marche super bien:ccool: