Renvoie à la ligne : Cellules fusionnées

  • Initiateur de la discussion Initiateur de la discussion blord
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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...
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
211
Réponses
10
Affichages
298
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
532
Retour