Discussion :

[ouskel'n'or]

Bonjour le forum,
J'ai un texte qui dépasse la longueur de la cellule dans des cellules fusionnées, "Renvoyer à la ligne automatiquement" étant validé dans le format de cellules, comment dimensionner la hauteur de la ligne automatiquement pour qu'il soit entièrement visible ?
Autofit ne semble pas fonctionner correctement quand les lignes comportent des cellules fusionnées.
Merci par avance de votre réponse

[Couettecouette]

Merci pour ton acharnement ... mais ... j'ai un gros blanc avant et une zone fusionnée autre qu'en colonne A n'est pas prise en compte dans mon fichier d'essai.

Alors je résume le style de fichier que j'ai et pour lequel je souhaite cette macro afin de finaliser un projet sur lequel je bosse depuis 11 mois :

- 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

Courage ...

[Couettecouette]

Bon, je peux faire en sorte de ne pas avoir plusieurs zones de cellules fusionnées sur une même ligne ... donc problème réglé.

Le gros blanc : le renvoi à la ligne a été fait mais dans la cellule fusionnée, j'ai en fait deux lignes blanches puis deux lignes comprenant mon texte.

Pour la zone de cellules fusionnées non prise en compte par la macro, elle se situait simplement au départ d'une autre colonne que la colonne A ... en fait la macro a marché à partir du moment ou le début de la zone fusionnée se situe en colonne A.

Merci à tous ceux qui planchent là-dessus ...

[SilkyRoad]

bonjour


Une procédure de Jim Rech

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
29
30
31
32
33
34
35
'ajuster automatiquement la hauteur de ligne de cellules fusionnées
'la macro est conçue pour agir sur des cellules fusionnées sur la
'même ligne (ou à l'aide du bouton "centrer sur plusieurs colonnes")
 
Sub AutoFitMergedCellRowHeight()
'Jim Rech, mpep
 
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

michel

[Couettecouette]

SilkyRoad -> ce code a déjà été tenté et ne fonctionne pas pour mon cas mais merci quand même.

ouskel'n'or -> t'es le meilleur ... courage ...

[ouskel'n'or]

Je peux tout expliquer !

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub test_255() 'Défense de rire !
Dim FL1 As Worksheet, Cell As Range, LC1, LC2
Dim NbC As Byte, HC, HC1, Rat
Dim ok As Boolean
Dim Plage as range
Application.DisplayAlerts = False
    Set FL1 = Worksheets("Feuil1")
    FL1.Cells.WrapText = True
    Set Plage = FL1.Range("A1:" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Address)
    For Each Cell In Plage
        'La cellule est-elle fusionnée à une autre
        If FL1.Range(FL1.Cells(Cell.Row, Cell.Column), _
            FL1.Cells(Cell.Row, Cell.Column)).MergeCells Then
            NbC = 0
            LC1 = 0
            ok = Not Cell.Column = 1
            'Si /ok on ne fait pas le test qui suit (Cell.column-1)
            If ok Then ok = ok And Not (FL1.Range(FL1.Cells(Cell.Row, Cell.Column - 1), _
            FL1.Cells(Cell.Row, Cell.Column - 1)).MergeCells)
            'mais si toujours ok, donc cellule de gauche non fusionnée, ou si la
            'cellule fusionnée testée se trouve sur la colonne 1
            'on traite
            If ok Or Cell.Column = 1 Then
                HC1 = Cell.Height
                'On recherche la largeur totals de la cellule fusionnée
                'on peut adapter le nbre limite possible (ici 6) de cellules fusionnées
                For i = 0 To 5
                    If FL1.Range(FL1.Cells(Cell.Row, Cell.Column), _
                        FL1.Cells(Cell.Row, Cell.Column + i)).MergeCells Then
                        LC1 = LC1 + FL1.Cells(Cell.Row, Cell.Column + i).Width
                        'et on compte le nombre de cellules fusionnées
                        NbC = NbC + 1
                    End If
                Next
                'fractionnement de la cellule fusionnée
                FL1.Range(FL1.Cells(Cell.Row, Cell.Column), _
                    FL1.Cells(Cell.Row, Cell.Column)).UnMerge
                'On adapte la hauteur de ligne pour la cellule contenant le texte
                Rows(Cell.Row).AutoFit
                'mesure de la largeur de la cellule contenant le texte
                LC2 = FL1.Cells(Cell.Row, Cell.Column).Width
                'Fusion des cellules
                FL1.Range(Cells(Cell.Row, Cell.Column), Cells(Cell.Row, Cell.Column + NbC - 1)).Merge
                DoEvents
                'calcul du rapport entre la largeur des cellules fusionnées
                '... et la largeur de la cellule contenant le texte
                Rat = LC1 / LC2
                'Application du ratio pour calcul de la hauteur de la cellule
                HC = Int((Cell.Height / Rat) + 0.5)
                'Application de la hauteur de ligne
                If HC > HC1 Then
                    FL1.Rows(Cell.Row & ":" & Cell.Row).RowHeight = HC
                    Else
                    FL1.Rows(Cell.Row & ":" & Cell.Row).RowHeight = HC1
                End If
            End If
        End If
    Next
End Sub

Couettecouette, As-tu déjà visité une usine à gaz ? Je t'offre une visite gratuite. Testée et tout.
Bon. J'espère que quelqu'un a plus simple parce que là, je nierai être l'auteur de ce code ! Même s'il règle en même temps et "à peu près" le pb de plusieurs cellules fusionnées sur la même ligne, du moment qu'elle sont séparées par des cellules non fusionnées.
Après ça, je me retire définitivement !
Il est permis de commenter, pas de critiquer...

Edit
Il restait un "cas" à traiter :
Plusieurs cellules fusionnées sur la même ligne avec hauteur de seconde cellule moins haute que la première : La ligne prenait la hauteur de la seconde cellule, donc de la moins haute. Et ça c'est pas bien. Bref, code corrigé.

[Couettecouette]

Commentaires :

- marche niquel mais que sur les zones de cellules fusionnées commençant en colonne A ... pas sur les zones de cellules fusionnées partout ailleurs dans la feuille.

- met une ligne blanche au-dessus du texte au sein de la zone de cellules fusionnées lors de l'exécution de la macro.

- J'ai mis une zone de 11 celulles fusionnées et cela me l'a réduit à 6, tout en ne faisant pas assez la bonne hauteur de ligne.

[Couettecouette]

Je vais devenir barge sérieux ... ... cela ne marche pas chez moi.

Ci-joint mon fichier essai bidon pour montrer le résultat.

Merci en tout cas.

[Couettecouette]

Question : as-tu un fichier bidon d'essai à joindre pour que je comprenne pourquoi ça cloche chez moi !?

[ouskel'n'or]

Reprends mon code de la réponse 6, je l'ai adapté à ta demande et l'ai testé sur ton fichier. Pour moi, c'est ok. Je te renvoie ton fichier avec la macro.

Tu le récupères que je puisse le supprimer de mes pièces jointes, je n'ai plus beaucoup de place (j'attends que tu me dises)

Fichier joint supprimé

[Couettecouette]

C'est récupéré et en effet, ça marche niquel !!!

Merci pour tout ouskel'n'or ... t'es un amour ...

[Couettecouette]

Ce n'est qu'une expression a.dequidt ...






Pour en revenir à la macro, j'ai LA solution finale, avec l'aide de quelqu'un bien entendu :

J'ai ajouté une macro supplémentaire qui va agir sur la plage utilisée et ce, de manière automatique. En reprenant le code de départ :

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 bien sûr.
Les deux macros sont à placer dans un module.

CA MARCHE NIQUEL donc problème résolu définitivement ... un grand merci à tous pour votre aide précieuse et vos heures de recherches ...