Ajustement automatique hauteur ListBox

job75 · 6 Mars 2017

Bonjour le forum,

Je n'ai trouvé nulle part de solution pertinente sur cette question mais j'en ai trouvé une pour ce fil :

https://www.excel-downloads.com/threads/visualisez-des-mauvais-accents.20015643/page-2#post-20116697

Elle utilise la propriété IntegralHeight de la ListBox.

Pour généraliser j'ai étudié la question pour les 2 types de ListBox, dans une feuille et dans un UserForm.

Voyez le fichier joint et ces 2 macros :

Code:

Private Sub Worksheet_Change(ByVal Target As Range) 'MAJ ListBox de la feuille
Dim z, i%, marges#
z = ActiveWindow.Zoom
Application.ScreenUpdating = False
If z <> 100 Then ActiveWindow.Zoom = 100
With ListBox1
  .Visible = False 'curieusement indispensable
  .List = [A4].CurrentRegion.Value
  .IntegralHeight = False: .Height = 0: .IntegralHeight = True: marges = .Height 'aucune ligne affichée
  .IntegralHeight = False: .Height = marges + .Font.Size: .IntegralHeight = True '1 ligne affichée
  .Height = (.Height - marges) * .ListCount + marges + 1 'toutes les lignes affichées
  .Visible = True
End With
ActiveWindow.Zoom = z
End Sub

Code:

Private Sub UserForm_Initialize()
Dim z, i%, marges#
With ListBox1
  .IntegralHeight = False: .Height = 0: .IntegralHeight = True: marges = .Height 'aucune ligne affichée
  .List = [A4].CurrentRegion.Value
  .IntegralHeight = False: .Height = marges + .Font.Size '1 ligne affichée
  DoEvents
  .IntegralHeight = True
  .Height = (.Height - marges) * .ListCount + marges + 1 'toutes les lignes affichées
  DoEvents
  Me.Height = .Height + 45
End With
End Sub

Il se produit des choses bizarres dans chaque macro :

- dans la 1ère, nécessité de masquer la ListBox

- dans la 2ème, nécessité de deux DoEvents.

A+

Lone-wolf · 6 Mars 2017

Bonjour job

Si tu n'a rien trouvé, ce n'est pas grave. Même si tu éstime que le code peut-être amélioré, pas grave non plus. L'important c'est que ça marche.

job75 · 6 Mars 2017

Bonjour Lone-Wolf,

La seule amélioration qui serait souhaitable serait pour la ListBox de la feuille : éviter son "saut" quand on modifie la feuille.

Je pense que ce n'est pas possible puisque comme je l'ai dit il est indispensable de masquer la ListBox pendant son redimensionnement (du moins chez moi sur Excel 2013).

J'en profite pour préciser que ce redimensionnement n'a d'intérêt que si le nombre de lignes est faible : une vingtaine au maximum, comme dans le cas du fil que j'ai mis en lien.

Au-delà il y a tout simplement les barres de défilement...

A+

Calvus · 6 Mars 2017

Bonjour, Job75, Lone-wolf,

Je ne vais rien apporter à cette discussion sauf que :

CETTE PAGE EST A MARQUER D'UNE PIERRE BLANCHE

JOB 75 A POSTE UNE DEMANDE SUR LE FORUM !!!

Comme quoi les miracles se produisent !

job75 · 6 Mars 2017

Bonsoir Calvus,

En 9 ans sur XLD je n'ai créé que 36 discussions.

Beaucoup, comme celle-ci, ne visent qu'à présenter ce que j'ai découvert.

Bonne fin de soirée.

job75 · 7 Mars 2017

Bonjour le forum,

Au cas où la propriété Zoom de l'USF serait <> 100 modifier UserForm_Initialize :

Code:

  Me.Height = 20 + Me.Zoom * (.Height + 25) / 100

Fichier (2).

Bonne journée.

job75 · 7 Mars 2017

Re,

J'ai finalement trouvé la solution pour réduire pratiquement à rien le "saut" de la ListBox quand on modifie la feuille.

Elle consiste à mémoriser dans un tableau les caractéristiques de la ListBox.

Ce tableau est réinitialisé à l'ouverture du fichier ou après une modification de la police.

Le code de la feuille :

Code:

Option Explicit
Dim mem(1 To 4) 'mémorisation de la variable
'mem(1) => nom de la police de la ListBox
'mem(2) => taille de la police
'mem(3) => marges de la ListBox
'mem(4) => hauteur de la ListBox pour 1 ligne affichée

Private Sub Worksheet_Change(ByVal Target As Range) 'MAJ ListBox de la feuille
Dim z
z = ActiveWindow.Zoom
If z <> 100 Then Application.ScreenUpdating = False: ActiveWindow.Zoom = 100
With ListBox1
  .List = [A4].CurrentRegion.Value
  If mem(1) <> .Font.Name Or mem(2) <> .Font.Size Then
    mem(1) = .Font.Name: mem(2) = .Font.Size
    .Visible = False 'curieusement indispensable
    .IntegralHeight = False: .Height = 0: .IntegralHeight = True: mem(3) = .Height 'aucune ligne affichée
    .IntegralHeight = False: .Height = mem(3) + .Font.Size: .IntegralHeight = True: mem(4) = .Height '1 ligne affichée
  End If
  .Height = (mem(4) - mem(3)) * .ListCount + mem(3) + 1 'toutes les lignes affichées
  .Visible = True
End With
ActiveWindow.Zoom = z
End Sub

Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Fichier (3).

A+

patricktoulon · 24 Novembre 2024

re
chez moi il n'y a pas de saut
et le .visible n'est pas nécessaire (office 2013 pro plus vba7 32 bits )
par contre dès que l'on sort cette sub du module feuille
plus rien ne fonctionne
il faut non seulement passer par oleobjects("ListBox1").object
mais il faut aussi le convertir en msforms.Listbox
sinon les .height et autres génèrent des erreurs de propriété non gérées

VB:

Sub test()
    Dim z, i%, marges#, LBX As MSForms.ListBox
    Set LBX = Sheets(1).OLEObjects("ListBox1").Object
    z = ActiveWindow.Zoom
    Application.ScreenUpdating = False
    If z <> 100 Then ActiveWindow.Zoom = 100
    With LBX
        '.Visible = False 'curieusement indispensable sauf si on travaille avec la collectionshapes plutot que l'activeX
        .Clear
        .List = [A1:A8].Value

        .IntegralHeight = False 'aucune ligne affichée
        .Height = 0
        .IntegralHeight = True
        marges = .Height
        .IntegralHeight = False '1 ligne affichée
        .Height = marges + .Font.Size
        .IntegralHeight = True
        .Height = (.Height - marges) * .ListCount + marges + 1 'toutes les lignes affichées
        '.Visible = True
    End With
    ActiveWindow.Zoom = z
End Sub

par contre ce que je comprends pas (j'ai essayé) c'est que si je ne dé zoom pas
1° la listbox s' élargi sans qu'on lui demande
2° même en appliquant marge/(z/100) le calcul n'est pas bon je retombe su 2.8875456 au lieu de 3
sauf que même si la différence est minime je me retrouve avec 3/ 4 hauteur d'item en plus
ce qui n'est pas logique vous en conviendrez

Ajustement automatique hauteur ListBox

job75

XLDnaute Barbatruc

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires