Discussion :

[Maze0]

Bonjour,

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

Merci

[Philippe Tulliez]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

bonjour

pour redimentionner dynammiquement un usf tu peu utiliser les apis

regarde "ICI"
au plaisir

[Maze0]

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

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

au plaisir

[Maze0]

Merci sa marche super bien