Macro "renvoi à la ligne automatique"

Code qui marche mais me laisse un gros espace blanc AVANT et APRES mon texte donc à revoir :

Sub AutoFitMergedCellRowHeight()

 
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single

Dim CurrCell As Range, Cel As Range

Dim ActiveCellWidth As Single, PossNewRowHeight As Single

For Each Cel In ActiveSheet.UsedRange ' <--- Zone à déterminer

On Error Resume Next ' <-----Ici

If Cel.MergeCells And Not Cel.Offset(0, -1).MergeCells Then ' <-----Ici

On Error GoTo 0 ' <-----Ici

Cel.Select

MergedCellRgWidth = 0: PossNewRowHeight = 0

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(Cel.Row, Cel.Column).ColumnWidth = MergedCellRgWidth

.VerticalAlignment = xlCenter

.EntireRow.AutoFit

PossNewRowHeight = .RowHeight

.Cells(Cel.Row, Cel.Column).ColumnWidth = ActiveCellWidth

.MergeCells = True

.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)

End If

End With

End If

Next Cel

End Sub

Mauvaise idée.

Très bonne idée. C'est parti.

Découpons ce gros problème en petits problèmes simples :

Comment désigner la feuille XXX ?

Comment désigner toutes les cellules d'une feuille ?

Comment parcourir les cellules d'une plage de cellules ?

Comment déterminer si une cellule est fusionnée avec une autre ou pas ?

Comment établir le renvoi automatique à la ligne pour une cellule ?

J'ai l'intention de t'aider, mais pas de te le faire. C'est comme ça.
Réponds donc à ces questions si tu peux.

Ensuite, on montera ça comme des LEGOs(R).  

Sheets("XXX").Select


   


For Each Cel In SelectSheets.UsedRange  


If XXX.Range(XXX.Cells(Cell.Row, Cell.Column), XXX.Cells(Cell.Row, Cell.Column + ?)).MergeCells


Un truc du genre : .WrapText = True  



Ah mon avis j'ai des fautes ...  

Je résume le style de fichier que j'ai :

- cellules fusionnées pouvant avoir plus de 2 cellules fusionnées entre elles
- cellules fusionnées pouvant se trouver dans n'importe quelle colonne de la feuille (donc pas forcément en colonne A)
- possibilité de plusieurs zones de cellules fusionnées sur une même ligne mais pas forcément côte à côte

Q: Comment désigner la feuille XXX ?
R: Sheets("XXX" ).Select
2/4

Oui et Non.
Sheets("XXX" ) tout court !!
Select sélectionne la feuille, ce dont nous n'aurons pas besoin.
Mais puisqu'il s'agit d'une feuille de calcul, autant utiliser WorkSheets("XXX" )

Q: Comment désigner toutes les cellules d'une feuille ?
R: ....
0/4

C'est pourtant si facile :
WorkSheets("XXX" ).Cells

Q: Comment parcourir les cellules d'une plage de cellules ?
R: For Each Cel In SelectSheets.UsedRange
4/4
Tu en fais trop !! Je n'ai demandé qu'une plage.
Disons que l'exemple n'est qu'un exemple.

Q: Comment déterminer si une cellule est fusionnée avec une autre ou pas ?
R: If XXX.Range(XXX.Cells(Cell.Row, Cell.Column), XXX.Cells(Cell.Row, Cell.Column + ?)).MergeCells
3,5/4
Tu en fait encore trop !! cel.MergeCells suffit.

Q: Comment établir le renvoi automatique à la ligne pour une cellule ?
R: Un truc du genre : .WrapText = True
4/4
Très bonne réponse.


13,5/20. Peut mieux faire  


Allez on mélange tout :

Dim cel As Range

For Each cel In WorkSheets("XXX").Cells

    If cel.MergeCells Then cel.WrapText = True

Next

C'est tout.
D'où l'idée de ne pas partir du bazar proposé au début.

Je suis en train de tester mais en fait je veux bien partir sur l'idée de la plage nommée (qui ferait par exemple A1 à Z100) car là ça prend toute ma feuille cellule par cellule et ça fait 5mn que ça réfléchi ...      

Est-ce que un code fait ainsi est bon monsieur le professeur :

Dim cel As Range

For Each cel In Range("PLAGENOMMEE" ).Cells

If cel.MergeCells Then cel.WrapText = True

Next

En tout cas merci de me faire participer car c'est ainsi qu'on apprend !!!

 

Résultat : ça n'a rien fait ...  

A tester :

Dim c As Range

 
Sub toto()

    MsgBox "La plage à parcourir est la suivante : " & _

           Range("PLAGENOMMEE").Address(0, 0)

 
    For Each c In Range("PLAGENOMMEE")

        If c.MergeCells Then

            MsgBox "Je suis la cellule " & c.Address(0, 0) & " et je suis fusionnée."

            c.WrapText = True

        End If

    Next

End Sub

Si tu sais ce qu'est la fenêtre d'exécution sous l'éditeur VB ([CTRL+G]), tu peux remplacer MsgBox par Debug.Print. C'est plus cool.

Tips: [CTRL+Pause] pour ^mettre une macro sur Pause  

Non je ne sais pas à quoi sert la fenêtre d'exécution ...  

Sinon, le code n'a rien fait de particulier sur mon fichier essai ... et avoir une fenêtre à valider cellule par cellule, on n'est pas rendu car j'ai un fichier réel bourré de cellules fusionnées à mettre à jour ...  

C'est pourquoi je t'en parle !!!!!

Dans l'éditeur de VB, tu cherches "fenêtre d'exécution", et tu testes CTRL+G et CTRL+Pause...

Comme je ne peux pas le faire à ta place, je te donnes toutes les billes pour que tu puisses débugger ton bazar toute seule.

Tu me parles chinois car je fais CTRL+G mais rien se passe ...  

Question bête mais puisque la macro n'a rien fait, je voulais m'assurer que tu savais que le renvoi à la ligne automatique du menu excel ne marche pas sur les cellules fusionnées, des fois que la macro passe par cette fonction ... d'où le problème à créer.

     

NanieCouette a dit :

Question bête mais puisque la macro n'a rien fait, je voulais m'assurer que tu savais que le renvoi à la ligne automatique du menu excel ne marche pas sur les cellules fusionnées, des fois que la macro passe par cette fonction ... d'où le problème à créer.

     

  Comment ça je ne sais pas ? Clique sur spoiler pour voir.
Le renvoi à la ligne fonctionne même sur les cellules fusionnées, par contre, la hauteur de la ligne ne prend pas automatiquement la taille du texte qui y est renvoyé à la ligne.

Voila, maintenant tu peux te plaindre et faire des jérémiades  

SOLUTION :

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 :

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.

 



Dans l'attente de tes remarques ...