[Fait]Ajuster la taille d'un sous-form en fonction du nb d'enregistrements [FAQ]

**The_Super_Steph** · 08/06/2007, 16h17

Bonjour,

Voilà, sur les conseils de Kikof, je mets à disposition un code que je cherchais à mettre en place pour ajuster la taille d'un sous-formulaire en fonction du nombre d'enregistrements qu'il contient. Ainsi, Arkham46 est venu à mon secours et m'a aiguillée vers la solution suivante :

Sur l'événement SurActivation du formulaire, il suffit de mettre le code suivant :

Code :

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

1
2
3
4
5
6
7
8
Private Sub Form_Current()
Me.TonSousForm.Form.InsideHeight = Me.TonSousForm.Form.Section(acHeader).Height _
     + Me.TonSousForm.Form.Section(acFooter).Height _
     + Me.TonSousForm.Form.Section(acDetail).Height _
         * (Me.TonSousForm.Form.RecordsetClone.RecordCount _
          -  Me.TonSousForm.Form.AllowAdditions)
Me.TonSousForm.Height = Me.TonSousForm.Form.WindowHeight
End Sub

Après, s'il y a des zones de textes en-dessous, il suffit de modifier leur position en fonction du sous-formulaire, par exemple :

Code :

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

Me.TazoneDeTexte.Top = Me.TonSousForm.Top + Me.TonSousForm.Height + AutantDeTwipsQueTuVeux

... et ainsi de suite !

Voilà, en espérant que cela pourra servir à d'autres... Ce code apporte réellement un plus à une appli, ça fait plus pro !

Encore merci à Arkham46,

Steph

**micniv** · 13/06/2007, 10h33

Une évolution pour ce script intéressant : limiter la hauteur du sous-form à Nmax lignes :

ajustement automatique de la hauteur du sous-form au nombre de lignes lorsque celui-ci est inférieur à Nmax
quand il y a plus de Nmax lignes, ça ajuste à Nax lignes avec une barre de défilement vertical

On peut coller le code suivant dans un module standard

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
74
 
Public Sub ssfrmHeightResize(nbMaxLignesAffichees As Integer, ctlSsFrm As Control)
'Positionnement du ss-formulaire
'--------------------------------
' twips : 567 dans 1 cm et 1440 dans 1 pouce.
' limite la hauteur du sous-form à nbMaxLignesAffichees lignes
' qd nbLignes > nbMaxLignesAffichees, on affiche le défilement vertical
 
    Dim heightMaxAllowedSsFrm As Long, heightTotalSsFrm As Long, widthSsFrm As Long
    Dim lineHeight As Long, calageAbsolu As Long, lngRecordCount As Long
    Dim oSsFrm As Form
    Dim rst As Recordset
 
    Set oSsFrm = ctlSsFrm.Form
 
    'Hauteur d'une ligne du sous-form
    '--------------------------------
    Debug.Print "width : " & Application.GetOption("default column width")    'en cm
    'Debug.Print "height: " & Application.GetOption("default row height")
    Debug.Print "height: " & oSsFrm.RowHeight    'en twips
 
    If oSsFrm.DefaultView = 2 Then
        'en mode DS
        lineHeight = 283
        'widthSsFrm = oSsFrm.Width           'ou bien un nombre en twips
    Else
        'en mode continu
        lineHeight = oSsFrm.Section(acDetail).Height
        'widthSsFrm = oSsFrm.Width + 50
    End If
 
    'Nombre de records dans le sousForm
    '-----------------------------------
    If oSsFrm.RecordsetClone.RecordCount > 0 Then
        oSsFrm.RecordsetClone.MoveFirst
        oSsFrm.RecordsetClone.MoveLast
        'Attention : The recordcount is unreliable when using a server side cursor
        lngRecordCount = oSsFrm.RecordsetClone.RecordCount
    Else
        lngRecordCount = 0
    End If
    Debug.Print "oSsFrm. lngRecordCount: " & lngRecordCount
 
    'Debug.Print "Form.Detail.Height avant: " & Me.Form.Section(acDetail).Height
    Debug.Print "oSsFrm. Detail.Height : " & oSsFrm.Section(acDetail).Height
 
    heightMaxAllowedSsFrm = oSsFrm.Section(acHeader).Height _
                          + IIf(oSsFrm.Section(acFooter).Visible, oSsFrm.Section(acFooter).Height, 0) _
                          + lineHeight _
                          * (IIf(oSsFrm.AllowAdditions, nbMaxLignesAffichees + 1, nbMaxLignesAffichees))
    Debug.Print "heightMaxAllowedSsFrm : " & heightMaxAllowedSsFrm
 
    heightTotalSsFrm = oSsFrm.Section(acHeader).Height _
                     + IIf(oSsFrm.Section(acFooter).Visible, oSsFrm.Section(acFooter).Height, 0) _
                     + lineHeight _
                     * (IIf(oSsFrm.AllowAdditions, lngRecordCount + 1, lngRecordCount))
    Debug.Print "heightTotalSsFrm      : " & heightTotalSsFrm
 
    If heightTotalSsFrm < heightMaxAllowedSsFrm Then
        'ctlSsFrm.Width = widthSsFrm + 150     'Largeur automatique du sous-form
        oSsFrm.InsideHeight = heightTotalSsFrm
        oSsFrm.ScrollBars = 0             'aucune barre de défilement
    Else
        'ctlSsFrm.Width = widthSsFrm + 410    'Largeur automatique du sous-form
        oSsFrm.InsideHeight = heightMaxAllowedSsFrm
        oSsFrm.ScrollBars = 2             'barre de défilement verticale
    End If
 
    Debug.Print "lineHeight: " & lineHeight
 
    Set ctlSsFrm = Nothing
    Set oSsFrm = Nothing
 
End Sub

qu'on appelle par exemple par le code suivant placé dans le formulaire PARENT du sous-form :

Code :

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

1
2
3
Private Sub Form_Current()    
        Call ssfrmHeightResize(3, Me!ssf_item_vente)
End Sub

Remarque : ce module fonctionne qlqsoient les conditions suivantes :
. SsFrm.AllowAdditions= True or False
. SsFrm.Section(acFooter).Visible=True or False
. pour sous-form en mode Continu ou en mode DS
Adaptez le code si d'autres conditions sont différentes

Cordialement

EDIT 09/06/2008 : ajout Remarque
EDIT 08/10/2008 : nouveau code

**Nessie37** · 21/03/2008, 11h35

Bonjour Micniv,

Peux t-on avoir ton code et celui de Steph en même temps ? sur le même événement ?

Merci

**voyou** · 21/03/2008, 17h16

A priori Micniv a pris le code de Steph et a rajouté du code en plus. Donc, celui de Micniv est le plus complet à ce que j'ai compris.

**Nessie37** · 26/03/2008, 15h22

Ok Ok !
de toute façon ça ne règle pas mon probl car le code ne fonctionne pas !
J'ai posté dans IMH à ce sujet....

**Nessie37** · 06/10/2008, 10h47

A nouveau moi,

Bonjour tout le monde.

Je souhaiterais exploiter le code de micniv mais il est vrai que j'ai encore des problèmes de syntaxe.
Micniv, le code que tu proposes serait donc en Private sub form_current() ?
De plus qu'entends tu par objSousFrom et frmSousForm ?

Que dois-je y mettre moi ?

Merci par avance.

**micniv** · 06/10/2008, 12h51

le code que tu proposes serait donc en Private sub form_current() ?

Oui, le sous-form a besoin d'être actualisé à chaque record du form principal.

qu'entends tu par objSousFrom et frmSousForm ?'

Regarde les déclarations
Set objSousForm = Me!TonSousForm
Set frmSousForm = objSousForm.Form

TonSousForm : est le nom du contrôle de ton sous-formulaire (à remplacer par le tien)
frmSousForm : est une déclaration de variable pour le ss-form (tu n'y touches pas)

A+

**Nessie37** · 06/10/2008, 16h35

Je n'arrive pas à retranscrire ton code car je ne suis aps très fortiche en syntaxe et je ne sais pas ce qui doit être changé ou gardé car syntaxe d'origine.

De toute façon, si les choses marchaient du premier coup avec moi ça se saurait...

Je ne sais plus qui m'a dit que ce code ne fonctionnait qu'avec des form en mode continu

Moi, il s'agit d'un sous form en mode feuille de données...

C'est pour cela qu'il ne se passe rien ?

SI non,
si je veux un ajustement automatique de mon ss-form au nombre de lignes lorsque celui-ci est inférieur à 8 et que dès qu'il y a plus de 8 lignes, ça s'ajuste aux 8 et pas plus avec barre de défilement horizontale, comment je fais ?
Comment dois-je mixer les 2 codes proposés ?

**micniv** · 06/10/2008, 17h07

1 je viens de mettre à jour le code. Plus moderne : à l'apple, il passe en paramètres, le nombre de lignes max et le nom du controle du sousForm.

2: Effectivement, il ne marche que pour des sous-forms en mode continu. Mais c'est facile de passer d'un mode à l'autre et c'est souvent plus présentable en mode continu (qu'en miode DS (Feuille de données))

**Nessie37** · 06/10/2008, 17h24

Le problème est que pour mon cas, le mode DS est plus approprié !

Donc il n'existe pas de code permettant l'ajustement en mode DS ?

**micniv** · 07/10/2008, 08h19

Je viens de vérifier le code proposé en mode DS.
Il fonctionne ... quand on fait défiler les enregistrements dans l'ordre croissant mais bug effectivement qd on revient en arrière.
J'essaie de regarder ça

**Nessie37** · 07/10/2008, 10h21

Merci bcp de te pencher dessus.

Mais une tite question, est-ce que ce que je souhaite, c'est-à-dire ça :

Envoyé par Nessie37

SI non, si je veux un ajustement automatique de mon ss-form au nombre de lignes lorsque celui-ci est inférieur à 8 et que dès qu'il y a plus de 8 lignes, ça s'ajuste aux 8 et pas plus avec barre de défilement horizontale, comment je fais ?
Comment dois-je mixer les 2 codes proposés ?

c'est faisable ?

**micniv** · 07/10/2008, 10h49

si je veux un ajustement automatique de mon ss-form au nombre de lignes lorsque celui-ci est inférieur à 8 et que dès qu'il y a plus de 8 lignes, ça s'ajuste aux 8 et pas plus avec barre de défilement verticale?

C'est exactement le but de la manoeuvre.

Comment dois-je mixer les 2 codes proposés ?

dans l'evenement Sur activation du formulaire principal, tu mets l'appel de la procédure (le second code) avec tes données :

Code :

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

1
2
3
Private Sub Form_Current()    
        Call ssfrmHeightResize( 8, Me!nomDuSousform)
End Sub

et tu recopies dans le même module, la 1ére procédure

A+

**Nessie37** · 07/10/2008, 11h44

Ya un problème avec mon "verticale" ? Qui fait référence à la barre

Pas si vite Monsieur Micniv !

Tu ne sais pas qui je suis ! Je suis Nessie ! Celle avec qui rien ne marche jamais du premier coup et qui plus est, est une vraie bleue quand les codes deviennent trop compliqués.
Rassure-toi j'ai compris ce que tu me disais là. ce qui me pose problème c'est les codes en eux-mêmes.
J'essaie de les adapter mais parfois, il y a des syntaxes qu'il ne faut pas forcément changer, etc... et donc, c'est pour ça que ça ne marche jamais avec moi

Bref, pour l'instant, je vais attendre tes corrections pour le/les codes en espérant me retrouver.....

Merci

**micniv** · 07/10/2008, 12h36

peux tu mettre un extrait zippé de ta base en PJ (form et ssForm avec quelques données)

A+

**Nessie37** · 07/10/2008, 14h46

Voilà un brouillon en vrac mais sans les codes d'ajustement

**micniv** · 07/10/2008, 17h32

Voici un exemple en réponse.

pour info j'ai revu ta table MEDIA en T_media pour saisir quelques enregistrements
A downloader depuis http://dl.free.fr/qqgY7WRm6

C'est vrai que le code n'est opas facile à manipuler : tu vois si ca en vaut la chandelle !

Salut

**Nessie37** · 07/10/2008, 17h41

Re, je viens à peine de télécharger le fichier. Donc pas eu le temps de voir ce que tu me demandes...Ne bouge pas ! T pas facile à joindre

**Nessie37** · 07/10/2008, 17h44

Je viens de l'ouvrir. Pourquoi as-tu changé la T_MEDIA ?
cela avait une importance pour le code que tu as mis ?
C'est fou, ça fonctionne ! Comment tu as fait ?
Tu as du te triturer l'esprit...

Faut que je remette ça en ordre dans ma vraie base mais avant, la modif de la T_MEDIA a t-elle une incidence ?

Je n'arriverai jamais à comprendre et à le reproduire !!

**micniv** · 07/10/2008, 18h22

J'ai changé en T_media pour modifier la relation avec Jonction que je n'aimais pas du tout. Mais mes changements ne doivnt pas te perturber.

Pour collerce code dans ta base, tu dois ajouter au form [Consult annonces]

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Private Sub Form_Current()
 
 Call ssfrmHeightResize(3, Me.jonction_sous_formulaire)
'tu mettras 8 au lieu de 3
 
End Sub
 
Public Sub ssfrmHeightResize(nbMaxLignesAffichees As Integer, ctlSsFrm As Control)
'Positionnement du ss-formulaire
'--------------------------------
' twips : 567 dans 1 cm et 1440 dans 1 pouce.
' limite la hauteur du sous-form à nbMaxLignesAffichees lignes
' qd nbLignes > nbMaxLignesAffichees, on affiche le défilement vertical
 
    Dim heightMaxAllowedSsFrm As Long, heightTotalSsFrm As Long
    Dim calageAbsolu As Long, lngRecordCount As Long
    Dim LineHeight As Long
    Dim oSsFrm As Form
    Dim rst As Recordset
 
    Set oSsFrm = ctlSsFrm.Form
 
    'Nombre de records dans le sousForm
    '-----------------------------------
    lngRecordCount = DCount("*", "jonction", " [refAnnonce]=" & Me.Refannonce)
    Debug.Print "oSsFrm. lngRecordCount: " & lngRecordCount
    'Attention : information :  The recordcount is unreliable when using a server side cursor
    Debug.Print "oSsFrm. RecordCount   : " & oSsFrm.RecordsetClone.RecordCount
 
    'Hauteur d'une ligne du sous-form
    If oSsFrm.DefaultView = 2 Then
    'en DS
    LineHeight = 250
    Else
    'en continu
    LineHeight = oSsFrm.Section(acDetail).Height
    End If
 
 
    'Debug.Print "Form.Detail.Height avant: " & Me.Form.Section(acDetail).Height
    Debug.Print "oSsFrm. Detail.Height : " & oSsFrm.Section(acDetail).Height
 
    heightMaxAllowedSsFrm = oSsFrm.Section(acHeader).Height _
                          + IIf(oSsFrm.Section(acFooter).Visible, oSsFrm.Section(acFooter).Height, 0) _
                          + LineHeight _
                          * (IIf(oSsFrm.AllowAdditions, nbMaxLignesAffichees + 1, nbMaxLignesAffichees))
    Debug.Print "heightMaxAllowedSsFrm : " & heightMaxAllowedSsFrm
 
    heightTotalSsFrm = oSsFrm.Section(acHeader).Height _
                     + IIf(oSsFrm.Section(acFooter).Visible, oSsFrm.Section(acFooter).Height, 0) _
                     + LineHeight _
                     * (IIf(oSsFrm.AllowAdditions, lngRecordCount + 1, lngRecordCount))
    Debug.Print "heightTotalSsFrm      : " & heightTotalSsFrm
 
    If heightTotalSsFrm < heightMaxAllowedSsFrm Then
        oSsFrm.InsideHeight = heightTotalSsFrm
        oSsFrm.ScrollBars = 0  'aucune barre de défilement
    Else
        oSsFrm.InsideHeight = heightMaxAllowedSsFrm
        oSsFrm.ScrollBars = 2  'barre de défilement verticale
    End If
 
 
    Debug.Print "LineHeight: " & LineHeight
    'ctlSsFrm.Height = oSsFrm.WindowHeight
    'ctlSsFrm.Height = oSsFrm.InsideHeight
 
    calageAbsolu = ctlSsFrm.Top + ctlSsFrm.Height + 0
    Debug.Print "calageAbsolu (en twips) :" & calageAbsolu
 
    ' Actualisation de la hauteur du formulaire
    '------------------------------------------
    'Me.Form.Section(acDetail).Height = calageAbsolu + 600
    'Me.CtlTab1.Height = calageAbsolu + 180
    'Me.libItem.Height = Me.CtlTab1.Height - 40
    'Debug.Print "Me.Form.Section(acDetail).Height: " & Me.Form.Section(acDetail).Height
 
    'Décalage des zones de textes en-dessous
    '-----------------------------------------------------
    'il suffit de modifier leur position en fonction du sous-formulaire,
    'Me.et_Lot.Top = calageAbsolu
    'Me.et_vendu.Top = calageAbsolu + 150
 
    'Ajustement de la fenêtre globale
    'Forms(NameForm).InsideHeight = Forms(NameForm).InsideHeight * k
    'Forms(NameForm).InsideWidth = Forms(NameForm).InsideWidth * k
    'Me.Form.InsideHeight = Me.Form.Section(acHeader).Height + Me.Form.Section(acDetail).Height + Me.Form.Section(acFooter).Height
    'Debug.Print "Me.Form.InsideHeight: " & Me.Form.InsideHeight
    'Debug.Print "Me.Form.WindowHeight: " & Me.Form.WindowHeight
 
    'Me.Form.Section(acDetail).Height = Me.CtlTab1.Height
    'Debug.Print "Form.Detail.Height après: " & Me.Form.Section(acDetail).Height
 
    'Debug.Print "LineHeight après: " & LineHeight
 
 
    Set ctlSsFrm = Nothing
    Set oSsFrm = Nothing
 
End Sub