Ajustement automatique hauteur ListBox

[job75]

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 :

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

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]

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]

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]

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]

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]

Bonjour le forum,

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

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

Fichier (2).

Bonne journée.

 

[job75]

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 :

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+