Discussion :

[Couettecouette]

Bonjour,

Je souhaiterais faire une macro renvoi à la ligne automatique cellules fusionnées.

En surfant sur le net, j'ai trouvé cette macro qui marche mais je ne comprend pas tout et ne sais pas comment lui dire de le faire automatiquement sur une feuille complète :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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

En fait, mon idée est de faire une macro qui dit : tu me cherches toutes les cellules fusionnées sur une feuille nommée XXX, et tu me fais le renvoi à la ligne automatique pour toutes.

Une idée en partant de ce code qui marche : : :

Merci pour votre aide précieuse.

[Couettecouette]

Tu peux tester ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub test3()
Dim FL1 As Worksheet, NoCol1, NoCol2, Cell As Range
    Set FL1 = Worksheets("Feuil1")
    For Each Cell In FL1.Range("A1:" & _
        FL1.Cells(Range("A65535").End(xlUp).Row, FL1.Range("IV1").End(xlToLeft).Column).Address)
        NoCol1 = Cell.Column
        NoCol2 = Cell.Column + 1
        If FL1.Range(FL1.Cells(Cell.Row, Cell.Column), FL1.Cells(Cell.Row, Cell.Column + 1)).MergeCells Then
            MsgBox Cell.Address & "  " & Cell
        End If
    Next
End Sub

A+

NB - Donne l'adresse de la première cellule de la fusion

Qu'entends-tu par "Donne l'adresse de la première cellule de la fusion" ?
J'ai tenté le code que tu m'as donné, cela reconnaît bien chaque cellule fusionnée puisque cela m'ouvre une fenêtre pour les lister une par une mais cela ne fait pas le renvoi à la ligne automatique.
Merci de me dire ce qu'il me manque.
Par ailleurs, est-ce obligatoire de lister ainsi car avec tout ce que j'ai, c'est long ?!?

[Couettecouette]

J'ai un débogage sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
            If Not (FL1.Range("IV" & Cell.Row - 1).End(xlToLeft).Column = 1 And _
                FL1.Range("A" & Cell.Row - 1) = Empty) Then

Je ne comprends pas l'idée du "insérer une ligne" !?!
Je ne veux pas insérer de ligne, je veux juste faire un renvoi à la ligne automatique.
Par ailleurs, autre précision : ma cellule fusionnée ne se trouve pas forcément en colonne A (des fois que ce soit important).
Merci pour ton aide.

[Couettecouette]

Alors, désolée si ma question n'était pas claire, je pensais qu'elle l'était.

J'ai tenté ton nouveau code, je peux en effet voir dans la barre de formule qu'une ligne est ajoutée après l'exécution de la macro ... mais le résultat n'est pas ce que j'attend malheureusement.

En effet, je veux un renvoi à la ligne automatique dans mes cellules fusionnées, ce qui se caratérise au final par la ligne qui se dimensionne correctement pour pouvoir voir tout mon texte.

Dans ton code, l'ajout est présent mais la ligne ne se redimensionne pas automatiquement donc cela ne change rien niveau visuel.

Désolée ...

Pour information : je peux avoir beaucoup plus que 3 cellules fusionnées.

Une autre idée ?

[Invité]

Bonsoir Ouskel'n'or,

Etes-vous certain que "autofit" fonctionne avec des cellules fusionnées.

Je n'en suis pas convaincu et j'ai même tendance à penser que non.

Mais si je me trompe tant mieux, j'ai perdu beaucoup de temps à trouver la solution et à modifier des fichiers pour rien.

Amicalement.

[Couettecouette]

Merci quand même ...

Sympa l'accueil quand j'estime que "renvoi à la ligne automatique" qui n'est autre que le terme utilisé par excel a été imcompréhensible, ce qui est involontaire.

Bref ... merci quand même.

[ouskel'n'or]

Hello Couettecouette,
Tu as raison. Dans la première partie de ta question... C'est la seconde qui m'a fourvoyé

"tu me cherches toutes les cellules fusionnées sur une feuille nommée XXX, et tu me fais le renvoi à la ligne automatique pour toutes."

Si tu avais simplement dit

"J'ai un texte qui dépasse la longueur de la cellule dans des cellules fusionnées, comment le renvoyer à la ligne automatiquement pour qu'il soit entièrement visible ? "

Nous étions cinquante à essayer de faire fonctionner ce foutu Autofit, y compris quand des cellules fusionnées se trouvent dans la ligne.
Maintenant qu'on sait, ta question paraît évidente mais avant qu'on savait pas, on savait pas.
A ta place je tenterais le coup et reposerais la question. Et pour te montrer, je vais le faire à ta place.
Tu reconnaîtras le sujet de la discussion
A+

[Couettecouette]

Merci ouskel'n'or ...

[Couettecouette]

SOLUTION :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Trouvercellfusionnées() 
Dim cell As Range 
  With ActiveSheet.UsedRange 
    For Each cell In .Cells 
      With cell 
          If .MergeCells = True Then 
          .Activate 
          .RowHeight = 12.75 
          Call AutoFitMergedCellRowHeight 
          End If 
      End With 
    Next cell 
  End With 
End Sub

Avec cette deuxième macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub AutoFitMergedCellRowHeight() 
'MAcro de Jim Rech 
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

Toujours démarrer sur la macro Trouvercellfusionnées.
Les deux macros sont à placer dans un module.