Rapport de message :*
 

Ajuster automatiquement la hauteur d'une ligne fusionnée

Titre du sujet : Ajuster automatiquement la hauteur d'une ligne fusionnée
par dedechseb le 26/08/2009 11:44:11

Bonjour,

Alors voilà un nouveau problème que j'ai à vous poser.

Je copie d'une feuille vers une autre des lignes de texte, sous forme de listing : une ligne = une "prestation".

Jusque là tout va bien.

Le truc c'est que dans la feuille source, le listing n'ayant pas besoin d'avoir une forme particulière, les lignes sont parfois assez longues.  En revanche sur la feuille finale la largeur est fixée par un nombre de cellules fusionnées que je ne peux pas modifier pour la bonne tenue de la pagination de toute la feuille.

J'ai donc trouvé ce petit bout de code que je place dans une boucle allant du début à la fin de la partie ou je liste les prestations et qui test chaque cellule afin de voir s'il faut ou non l'ajuster :


Sub AutoFitMergedCellRowHeight()

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
 
 If ActiveCell.MergeCells Then
   With ActiveCell.MergeArea
     .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
     If .Rows.Count = 1 Then 'And .WrapText = True Then
       Application.ScreenUpdating = False
       CurrentRowHeight = .RowHeight
       ActiveCellWidth = ActiveCell.ColumnWidth
       For Each CurrCell In Selection
           MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
       Next
      .MergeCells = False
      .Cells(1).ColumnWidth = MergedCellRgWidth
      .EntireRow.AutoFit
       PossNewRowHeight = .RowHeight
      .Cells(1).ColumnWidth = ActiveCellWidth
      .MergeCells = True
      .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
     End If
   End With
 End If
 
End Sub


Le soucis que je rencontre est qu'il me réajuste parfois des lignes qui n'en ont pas besoin, et je me retrouve alors avec un paquet de ligne bien trop grandes qui désorganisent ma pagination en faisant déborder le texte de fin de page sur une deuxième page.

D'après un de mes amis ce serait un problème au niveau du test de la longueur des caractères, et de la taille de cellule...  Je vous avouerai que sur ce morceau de code j'ai un peu de mal à m'y retrouver et à comprendre ce qu'il se passe...

Je vous joins un petit fichier Excel de test pour vous donner une meilleure idée de la chose, sachant qu'évidemment la manipulation que j'essaye de vous exposer ne fonctionne pas dans cet exemple.... 
Le problème affiché par le débugeur me revient assez souvent et je ne sais pas comment y remédier à part en changeant de méthode de sélection de la cellule.  Dans ce cas là j'ai épuisé mon stock d'idées... 


Merci d'avance pour votre aide !