Dimensionner un Userform

**eliot.raymond** · 19/09/2013, 14h31

Bonjour a toutes et tous, Forum bonjour

Je suis a la recherche d'un code VBA qui me permetterai de dimensionner un

Userform avec soit des spinbouttons ou les scrollbars de l'userform.

Mon programme est en cours de réflexion et si je peux redimmensionner, ca serai

Top, bien sur, j'ai chercher mais pas trouver mon bonheur.

But: Utiliser le futur un programme de compta sur différents Pc et portables

et je souhaiterai ajuster a ma convenance l'userform.

MAIS pas d'ajustement a l'écran dans mon cas, ca ne sera pas pratique.

Merci a tous de votre aide et pour votre savoir.

bonne après midi a tous.

Cordialement Ray

**parmi** · 19/09/2013, 15h39

Bonjour,

Je ne suis pas certain si c'est ceci que tu recherches à faire, mais ça vaut le détour
http://www.andypope.info/vba/resizeform.htm

**eliot.raymond** · 20/09/2013, 14h48

Salut parmi

merci pour ta réponse et pour le lien, c'est sympa

bon j'ai essayer et fouiner sur le lien mais ca ne réponds pas tout a fait

a mon besoin

l'USF s'agrandi et diminue bien mais le contenu de l'USF ne s'adapte pas a un

affichage correct puisque rien ne bouge dans l'USF.

Déja un début, il y a surement quelque chose a faire, mais moi je ne sais pas

coder pour y parvenir.

le fichier "FormResizer" qui est dans le lien est toutefois une bonne approche.

Encore merci a toi pour ton aide

a plus tard

Cdtl Ray

Bonjour a tous, forum bonjour

J'ai de nouveau fait des recherches mais sans résultat, il y a bien des codes sur le net mais cela ne corresponds pas a mon besoin.

Si quelqu'un pouvait me donner un petit coup de main sur ce coup la, ca serai bien sympa.

Merci par avance de votre aide et bonne après midi a vous.

Cdlt Ray

Invité · 20/09/2013, 14h59

En cherchant un peu:
http://www.developpez.net/forums/d93...dans-userform/

**eliot.raymond** · 20/09/2013, 15h20

Salut vcottineau,

Merci beaucoup pour ta réponse , j'ai vu lors de mes recherches le code que tu me propose voir svp ci-dessous

mais je n'arrive pas a le faire fonctionner il demande de déclarer des variables et je n'arrive pas mettre les bons codes.

Merci pour ton aide

Cdlt Ray

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
 
Private Sub UserForm_Resize()
On Error Resume Next
I = 0
For Each ctrl In Me.Controls
I = I + 1
'largeure du control=largeure usf actuelle divisée par entre parenthezes  largeur usf de depart divisée par largeur de depart du control
ctrl.Width = Me.Width / (largeure_usf / largeurbouton(I))
'hauteur du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par hauteur de depart du control
ctrl.Height = Me.Height / (hauteure_usf / hauteurbouton(I))
'le left du control = largeur usf actuelle divisée par entre parenthezes  largeur usf de depart divisée par le left de depart du control
ctrl.Left = Me.Width / (largeure_usf / leftbouton(I))
'le top du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par le top de depart du control
ctrl.Top = Me.Height / (hauteure_usf / topbouton(I))
'le top du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par le top de depart du control
ctrl.FontSize = ((Me.Height + Me.Width) / 8) / (fontbouton * 2)
Next
largeur = Me.Width  '////////////////////////////////////////////
                    '///affiche les dimensions dans les textbox//
hauteur = Me.Height '////////////////////////////////////////////
 
Me.Repaint 'repeint le userform pour effacer les traces des anciens emplacement des control(du a la puissance de la carte graphique)
End Sub

**parmi** · 20/09/2013, 15h56

Je ne suis pas certain que ce soit une bonne approche de changer systématiquement la grosseur des contrôles. Peut-être devrais-tu plutôt les bouger seulement, surtout dans le cas de boutons ?

Si tu as des listbox (ou certains autres contrôles), par contre, la redimension peut être intéressante...

**Docmarti** · 20/09/2013, 16h27

Voici une version modifiée qui ne demande de déclarer que 2 variables.

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
32
33
34
35
36
37
38
39
40
41
Dim largeure_usf
Dim hauteure_usf
 
Private Sub UserForm_Initialize()
 largeure_usf = Me.Width
 hauteure_usf = Me.Height
End Sub
 
Private Sub CommandButton2_Click()
 
'test
Me.Width = Me.Width - 50
Me.Height = Me.Height - 50
End Sub
 
Private Sub CommandButton1_Click()
 
'test
Me.Width = Me.Width + 50
Me.Height = Me.Height + 50
End Sub
 
 
Private Sub UserForm_Resize()
On Error Resume Next
 
For Each ctrl In Me.Controls
 
 ctrl.Width = ctrl.Width * (Me.Width / largeure_usf)
 ctrl.Height = ctrl.Height * (Me.Height / hauteure_usf)
 ctrl.Left = ctrl.Left * (Me.Width / largeure_usf)
 ctrl.Top = ctrl.Top * (Me.Height / hauteure_usf)
 ctrl.FontSize = ctrl.FontSize * (Me.Width / largeure_usf)
Next
 
largeure_usf = Me.Width
 
hauteure_usf = Me.Height
 
Me.Repaint 'repeint le userform
End Sub

**nibledispo** · 24/09/2013, 16h19

Re... Patrick,

Merci pour le document.

Je ne comprends strictement rien à l'Anglais mais en recherchant les "declare" et "ptrsafe" dans le texte, j'en ai déduit que c'est le cas VBA7 qui nous concernait. (je ne sais d'ailleurs pas ce qu'est VBA7)

La modification est finalement très simple : il suffit d'ajouter "ptrsafe" juste après tous les déclare. A savoir : declare ptrsafe function .....
C'est du moins ce que j'ai conclu après ouverture de l'userfom sans problème.

J'apporte ces précisions pour ceux qui, comme moi, rencontreraient ce problème lié au 64 bits.

Il ne me reste plus qu'à essayer ton programme.

Cordialement

**parmi** · 24/09/2013, 16h55

Excellent boulot Patrick

Invité · 24/09/2013, 16h58

Envoyé par nibledispo

Re... Patrick,

Merci pour le document.

Je ne comprends strictement rien à l'Anglais mais en recherchant les "declare" et "ptrsafe" dans le texte, j'en ai déduit que c'est le cas VBA7 qui nous concernait. (je ne sais d'ailleurs pas ce qu'est VBA7)

La modification est finalement très simple : il suffit d'ajouter "ptrsafe" juste après tous les déclare. A savoir : declare ptrsafe function .....
C'est du moins ce que j'ai conclu après ouverture de l'userfom sans problème.

J'apporte ces précisions pour ceux qui, comme moi, rencontreraient ce problème lié au 64 bits.

Il ne me reste plus qu'à essayer ton programme.

Cordialement

Attention tout de même car ce n'est parfois pas si simple.

http://arkham46.developpez.com/artic...vba64bits/#LIV
https://www.microsoft.com/en-us/down...s.aspx?id=9970

**eliot.raymond** · 24/09/2013, 18h18

Salut Patrick,

j'ai réussi a adapter ton code a mon USF et ca marche

je modifie comme je le souhaitai en me placant dans l'angle de l'usf

Sur mon usf j'ai pas mal de labels qui sont rangés tous très correctement voir svp photo ci-jointe

Cependant quand j'agrandi l'usf ca déforme ou décale quelque peu l'alignement
de mes labels voir sur l'image j'ai mis des croix rouges pour repère

Quand je diminue l'usf le défaut ne se modifie en reprenant l'aspect initial

Je ne sait pas pourquoi ce soucis

j'ai compresser un bout de l'image te montrer sinon ca ne passe pas

Merci a toi bonne soirée

Cdlt Ray

**patricktoulon** · 24/09/2013, 18h29

peux tu poster juste ton usf sans les données juste les controls ?

je regarderais ca

**eliot.raymond** · 24/09/2013, 18h45

Salut Patrick

ok j'arrange ca et j'envoi pour jeudi demain absent toute la journée obligé

merci pour ton aide bonne soirée je regarde ca de suite pour m'avancer

PS: pour infos j'ai également fait l'essai sur pc portable écran 17 pouces

ca fait pareil.

mais ca marche

A plus tard merci beaucoup

Cdlt

**Docmarti** · 25/09/2013, 06h57

Bonjour eliot.raymond.

Voici qui me semble répondre à ta demande.
J'ai tenu compte des remarques et conseils et de l'expérience de Patrick concernant, entre autres, le fontsize qui exige un traitement particulier.

Cordialement,

Docmarti

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Dim Largeur_Actuelle
Dim Hauteur_Actuelle
 
Private Sub SpinButton1_Change()
 
    h = SpinButton1.Value
 
    Me.Move Me.Left, Me.Top, Me.Width, h
 
End Sub
 
Private Sub SpinButton2_Change()
 
    w = SpinButton2.Value
 
    Me.Move Me.Left, Me.Top, w, Me.Height
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Largeur_Actuelle = Me.Width
    Hauteur_Actuelle = Me.Height
 
    Call sauverTag
 
    SpinButton2.Max = Application.Width
    SpinButton2.Value = Me.Width
    SpinButton2.Min = 10
    SpinButton2.SmallChange = 5
 
    SpinButton1.Max = Application.Height
    SpinButton1.Value = Me.Height
    SpinButton1.Min = 10
    SpinButton1.SmallChange = 5
 
    SpinButton1.Value = Me.Height
    SpinButton2.Value = Me.Width
 
End Sub
 
Sub sauverTag()
 
    On Error Resume Next
    For Each c In Me.Controls
        c.Tag = c.Width / c.FontSize
 
    Next
 
End Sub
 
Private Sub UserForm_Resize()
 
    On Error Resume Next
 
    For Each c In Me.Controls
 
        c.Width = c.Width * (Me.Width / Largeur_Actuelle)
        c.Height = c.Height * (Me.Height / Hauteur_Actuelle)
        c.Left = c.Left * (Me.Width / Largeur_Actuelle)
        c.Top = c.Top * (Me.Height / Hauteur_Actuelle)
 
        c.FontSize = c.Width / c.Tag + 0.01
 
    Next
 
    Largeur_Actuelle = Me.Width
 
    Hauteur_Actuelle = Me.Height
 
    Me.Repaint 'repeint le userform
 
End Sub

**eliot.raymond** · 25/09/2013, 07h47

salut a tous, Forum

Bonjour Docmarti

Merci pour ta réponse et pour le code, je ferai l'essai de ton code en fin d'après midi je ne suis pas dispo jusqu'a 17 h

tu a vu mon dernier post adresser a l'ami Patrick concernant un petit souci sur l'usf une fois que l'on agrandie, j'ai joint une photo

je posterai mon fichier ce soir

je te souhaite une agréable journée

Merci pour ton aide

Cdlt Ray

**patricktoulon** · 25/09/2013, 12h12

re
Bonjour a tous
un petit plus pour l'ami nouveau2 qui a ajouté la gestion 64/32 bits
je n'ai pas essayé mais le code m'a l'air propre: cool:
maintenant avoir l'élasticité sans le cadre ni captions c'est possible mais c'est une autre astuce

Au plaisir

re
pour docmarti

il faut savoir que "on error resume next" ne résous pas tout

ici tu met

Code :

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

1
2
3
4
5
6
7
Sub sauverTag()
 
    On Error Resume Next
    For Each c In Me.Controls
        c.Tag = c.Width / c.FontSize
 
    Next

donc si j'ai 50 contrôles et que le 25 eme n'a pas cette propriété la boucle saute donc les 25 autres ne seront pas traité
tu vois ce que je veux dire ?

Re
une premiere solution pour nouveau2

avec les coordonnées de la souris déterminer quand l'élasticité doit être

ici un exemple :

Code :

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

1
2
3
4
5
6
7
8
9
 
'SI LA SOURIS SE TROUVE DANS L'ANGLE BAS A DROITE LE CADRE ELASTIQUE EST PRESANT SINON PAS DE CADRE 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If x > Me.InsideWidth - 5 And y > Me.InsideHeight - 5 Then
modif_userform Me, &H140F0101, True
Else
modif_userform Me, &H94080080, True
End If
End Sub

Au plaisir

**Docmarti** · 25/09/2013, 13h44

Envoyé par patricktoulon

re
pour docmarti

il faut savoir que "on error resume next" ne résous pas tout

ici tu met

Code :

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

1
2
3
4
5
6
7
Sub sauverTag()
 
    On Error Resume Next
    For Each c In Me.Controls
        c.Tag = c.Width / c.FontSize
 
    Next

donc si j'ai 50 contrôles et que le 25 eme n'a pas cette propriété la boucle saute donc les 25 autres ne seront pas traité
tu vois ce que je veux dire ?

Non Patrick. Pas du tout. Ce que tu décris, c'est le comportement de On Error Goto. Tu peux vérifier avec la touche F8 que, après On Error Resume Next, le code ne s'arrête pas mais qu'il continue comme s'il n'avait pas rencontré d'erreur. C'est très utile car après une commande qui risque de provoquer une erreur, on peut peut vérifier si l'erreur attendue s'est produite par

Code :

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

1
2
3
If Err <> 0 then
 
End if

Va voir l'aide de VBA au sujet de Resume Next qui dit :

"On Error Resume Next : Lorsqu'une erreur d'exécution survient, le contrôle est transmis à l'instruction qui suit immédiatement celle où l'erreur s'est produite, et l'exécution continue. Il est recommandé d'utiliser cette formulation plutôt que l'instruction On Error GoTo pour accéder à des objets."

**patricktoulon** · 25/09/2013, 14h21

bonjour docmarti

Moi j'ai toujours appris que pour remettre le conteur d'erreur a zéro il fallait mettre juste en dessus de next 'on error goto 0"

sans ca je suis persuadé que la boucle est stoppée l'ors de l'erreur

j'ai eu d'ailleurs affaire a ce problème dans des modules plus complexes

mais je reste aussi persuadé que la gestion du problème avant l'erreur reste une meilleure solution

dans ce cas présent les exceptions sur les contrôles (sans font size) sont beaucoup mieux avec typename(nom du control)
A mediter

Au plaisir

Dimensionner un Userform [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager