Renvoie à la ligne : Cellules fusionnées

blord

XLDnaute Impliqué
Bonjour à tous,

J'ai trouvé ce code, sur le forum (merci aux gens du forum...!) qui permet de renvoyer à la ligne du texte dans des cellules fusionnées :

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 fusion fonctionne bien mais là ou ça accroche c'est lorsque l'on efface le contenu de la cellule... Une erreur se produit au niveau de "With Target.MergeArea"

J'ai essayé de modifier la macro en ajoutant

If ActiveCell.Value <> "" Then le code
ou
If Target.Value <> "" Then le code

mais ça ne fonctionne pas.

Idéalement, il faudrait que la ligne revienne à sa hauteur après avoir effacé le contenu des cellules fusionnées.

Merci de votre aide si précieuse...
 

Discussions similaires

Réponses
4
Affichages
355

Membres actuellement en ligne

Statistiques des forums

Discussions
314 062
Messages
2 105 220
Membres
109 290
dernier inscrit
ninouedf