Re : Comment Faire Renvoyer A Ligne Du Texte Dans Des Cellules Fusionner
Les amis!
deux personnes m'ont trouvé deux solutions différentes.
Pour info, pour les personnes qui liront ce message plus tard, il faut copier la macro directement dans l'éditeur VBA dans les cadres des "feuill1", "feuill2"...
La première ne demande aucune modification! Néanmoins, l'ajustement n'est pas très précis. On fait, les lignes sont beaucoup plus hautes que nécessaire!
Mais le texte des cellules fusionnées apparait ce qui est le prinicpal objectif.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
' Test la cellule ou à été fait la modif
If Target.MergeCells Then
With Target.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 = Target.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
La deuxième macro (que je n'ai pas encore essayé) ajuste les lignes en fonction du nombre de caractères écrits dans les cellules fusionnées.
Pour cette macro, dès qu'il y a plus de 35 caractères sur la même ligne, la macro en crée une deuxième automatiquement.
Attention, pour vos tableaux, il faut peut être réadapté le 35. Si vos cellules sont fusionnées sur 7 colonnes, le nombre de caractères qui remplissent la ligne peut être de 200. Donc, il faut modifier les "35" dans la macro par des "200".
A l'inverse, si vos cellules sont fusionnées sur 2 colonnes, il se peut qu'une ligne ne puisse contenir que 20 caractère.
Il faut donc remplacer les "35" par des "20"
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Test la cellule ou à été fait la modif
If Target.MergeCells Then
With Target.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
If .Rows.Count = 1 Then
Application.ScreenUpdating = False
If Round(Len(Target.Value) / 35, 0) < 1 Then
.RowHeight = 15 'Hauteur de ligne standard
Else
.RowHeight = 15 * (Round(Len(Target.Value) / 35, 0)) 'Modifier le dénominateur pour régler le nb de caractères par ligne
End If
End If
End With
End If
End Sub
'PARAMETRES
'hauteur de ligne standard = 15
'nb de caractères approximatifs par ligne = 35
'taille de la police = 10
Merci au forum pour le coup de pouce...
