Ajuster la hauteur de ligne selon texte de cellules fusionnées

Bonjour à tous

J'aimerai que lorsque je rempli la cellule A4, qui est fusionnée, et laquelle j'ai demandé un retour à la ligne automatique, celle-ci s'agrandisse automatiquement en fonction de son remplissage.

Pourriez vous m'aider?

Bonjour djodjo,

Pour commencer on trouve souvent ses questionnements en utilisant l'enregistreur de macros

Malheureusement avec des cellules fusionnées l'AutoFit n'est pas possible

Il me semble avoir vu passer un jour une usine à gaz pour calculer la largeur des cellules avec la largeur du texte et de mettre la ligne à la hauteur

A+

BrunoM45,

Merci de me répondre. Pareils mais je ne la retrouve pas.

Re

@djodjo j'ai retrouvé et simplifié la procédure

Sub HauteurLigneMergeArea(MergedZone As Range)
  Dim Zone1Cel As Range
  Dim Ind As Long
  Dim LargeurTotale As Single
  ' Désactiver les évènement
  Application.EnableEvents = False
  ' Définir la cellule qui va contenir le text
  Set Zone1Cel = ActiveSheet.Range("Z" & MergedZone.Row)
  'Déterminer la largeur totale de la zone fusionnée
  For Ind = 1 To MergedZone.Columns.Count
    LargeurTotale = LargeurTotale + MergedZone.Columns(Ind).ColumnWidth
  Next
  ' Appliquer la largeur totale à la colonne 1
  Zone1Cel.ColumnWidth = LargeurTotale - 1
  ' Inscrire dedans le texte
  Zone1Cel.Value = MergedZone.Cells(1, 1).Value
  ' Appliquer le retour à la ligne de la cellule unique
  ' et son ajustement automatique
  With Zone1Cel
    .WrapText = False
    .WrapText = True
    .Rows.AutoFit
  End With
  ' Forcer la hauteur de ligne
  MergedZone.RowHeight = Zone1Cel.RowHeight
  ' Effacer le contenu de la cellule unique
  Zone1Cel.Clear
  ' Réactiver les évènement
  Application.EnableEvents = True
  Set Zone1Cel = nothing
End Sub

Et elle est appelé avec une sub dans Feuil1

Private Sub Worksheet_Change(ByVal Target As Range)
  ' Uniquement pour la cellule A3
  If Target.Resize(1, 1).Address = "$A$3" Then Call HauteurLigneMergeArea(Target.MergeArea)
End Sub

A+

Nota : je me suis permis de modifier ton titre pour qu'il soit plus explicite

@BrunoM45,

Je viens de faire, mais fonctionne pas

Re,

Heuuuu

Chez moi ça fonctionne parfaitement, mais je suis en O365

Un message d'erreur ?

@BrunoM45

Je n'avais pas la "macro3", juste encore une question:

Pour mettre le texte tout à gauche automatiquement?

Oups pardon c'est réglé , je n'avais pas fait attention

Re,

Désolé, je n'ai pas fait le ménage dans le fichier donné, c'est chose faite

Les 2 sub supplémentaires ne servent à rien

@BrunoM45,

Un grand MERCI, pour cette solution.

Bonne journée

Mille excuses BrunoM45,

J'ai éssayé de transposer ton code dans mon fichier, mais je ni arrive. Je ne trouve pas mon erreur:

Les cellule concernées sont:

B29; B33; B37 et B40

Merci beaucoup

Re,

Normal, dans "Feuil1" vous n'avez que cette ligne

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Resize(1, 1).Address = "$b$29" Then Call HauteurLigneMergeArea(Target.MergeArea)
End Sub

Qu'est-ce que vous ne comprenez pas dans cette instruction ?

A+

Même pour cette seule instruction cela ne fonctionne pas. Du moins chez moi

Re,

Vos macros sont activées 🤔

Oui oui pas de soucis de ce côté là

Re,

Si les cellules indiquées sont bien dans la feuil1, vous pouvez essayer

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B29,B33,B37,B40")) Is Nothing Then
    Call HauteurLigneMergeArea(Target.MergeArea)
  End If
End Sub

Mais chez moi cela fonctionne, désolé

Revoici le fichier modifié

A+

Alors là j'en perds mon Latin. Ne fonctionne pas chez moi.

Je suis sous Office Professionnel Plus 2021

Re,

Et bien moi aussi

Dans le menu Fichier -> Options -> Centre de gestion de la confidentialité -> Paramètres du centre ...

Vous avez bien

A+

Nota : merci de changer la version dans votre profil

Pour moi c'est:

Dans le menu Fichier -> Options -> Centre de gestion de la confidentialité -> Paramètres des Macros

A+

Nota : merci de changer la version dans votre profil

Fait, merci je n'y avais pas pensé