Macro "renvoi à la ligne automatique"

NanieCouette

Nouveau membre
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:
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, ce qui se caratérise au final par la ligne qui se dimensionne correctement pour pouvoir voir tout mon texte.

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

Merci pour votre aide précieuse.

:bounce:
 

NanieCouette

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

Code:
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
 

zeb

Modérateur
Une idée en partant de ce code qui marche ? :whistle:
Mauvaise idée.

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, ce qui se caratérise au final par la ligne qui se dimensionne correctement pour pouvoir voir tout mon texte.
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. [:spamafote]
Réponds donc à ces questions si tu peux.

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

NanieCouette

Nouveau membre
Comment désigner la feuille XXX ?
Sheets("XXX").Select

Comment désigner toutes les cellules d'une feuille ?
:heink: :(

Comment parcourir les cellules d'une plage de cellules ?
For Each Cel In SelectSheets.UsedRange :whistle:

Comment déterminer si une cellule est fusionnée avec une autre ou pas ?
If XXX.Range(XXX.Cells(Cell.Row, Cell.Column), XXX.Cells(Cell.Row, Cell.Column + ?)).MergeCells

Comment établir le renvoi automatique à la ligne pour une cellule ?
Un truc du genre : .WrapText = True :sarcastic:



Ah mon avis j'ai des fautes ... :pt1cable:

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
 

zeb

Modérateur
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 :o


Allez on mélange tout :

Pour chaque cellule de toutes les cellules de la feuille XXX, si cette cellule est fusionnée, mettre sa propriété WrapText à vrai :
Code:
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 ne sais pas pourquoi, je sens venir les plaintes et les jérémiades à propos d'Excel)
 

NanieCouette

Nouveau membre
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 ... :pt1cable: :D :whistle:

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

[cpp]
Dim cel As Range
For Each cel In Range("PLAGENOMMEE" ).Cells
If cel.MergeCells Then cel.WrapText = True
Next

[/cpp]

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

:bounce:
 

zeb

Modérateur
A tester :
Code:
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 ;)
 

NanieCouette

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

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 ... :pt1cable:
 

zeb

Modérateur
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.
 

NanieCouette

Nouveau membre
Tu me parles chinois car je fais CTRL+G mais rien se passe ... :whistle:

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.

:D :pt1cable: :D
 

zeb

Modérateur



:sol: 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. [:spamafote]

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

NanieCouette

Nouveau membre
SOLUTION :

Code:
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:
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.

:bounce:



Dans l'attente de tes remarques ... :whistle:
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 055
Membres
1 586 282
Dernier membre
Yannick3553
Partager cette page
Haut