XL 2013 Ajustement automatique hauteur de ligne

Moussetictac · 29 Juin 2018

Bonjour,

J'aimerais savoir si c'est possible d'ajuster automatiquement la hauteur d'une cellule fusionnée dans un document Excel, avec une macro dont je n'ai malheureusement pas la maîtrise ?

En exemple, je téléverse un fichier.

Je remercie déjà très sincèrement la personne qui pourra me donner une réponse … clé en mains.

Avec mes salutations les meilleures et à tout bientôt, j'espère

Moussetictac

job75 · 29 Juin 2018

Bonsoir Moussetictac, bienvenue sur XLD,

Voici une solution qui utilise une TextBox auxiliaire avec ses propriétés :

- MultiLine => True

- Visible=> False (elle est toujours masquée).

Le double-clic déclenche cette macro :

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Target.MergeCells Then Exit Sub
Dim i&
Cancel = True
Application.ScreenUpdating = False
TextBox1.AutoSize = False
TextBox1.Width = Target.Width
TextBox1 = Target(1)
TextBox1.AutoSize = True
For i = 1 To 818 'hauteur maximum d'une ligne : 409
    Target.RowHeight = i / 2
    If Target.Height > TextBox1.Height Then Exit For
Next
End Sub

Fichier joint.

A+

job75 · 30 Juin 2018

Bonjour Moussetictac, le forum,

Pas bien fameuse la méthode de la TextBox, celle-ci est bien mieux :

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Target.MergeCells Then Exit Sub
Dim L, CW, i&
Cancel = True
Application.ScreenUpdating = False
L = Target.Width: CW = Target(1).ColumnWidth
Target.UnMerge 'défusionne
For i = 1 To 510 'largeur maximum d'une colonne 255
    Target(1).ColumnWidth = i / 2
    If Target(1).Width > L Then Target(1).ColumnWidth = (i - 1) / 2: Exit For
Next
Target(1).WrapText = True 'renvoi à la ligne
Target(1).Rows.AutoFit 'ajustement hauteur
Target(1).ColumnWidth = CW
Target.Merge 'refusionne
End Sub

Fichier (2).

Bonne journée.

job75 · 30 Juin 2018

Re,

Avec ce fichier (3) un 2ème double-clic remet la ligne à sa hauteur initiale.

A+

Moussetictac · 30 Juin 2018

job75 à dit:
Re,

Avec ce fichier (3) un 2ème double-clic remet la ligne à sa hauteur initiale.

A+

Rebonjour,

C'est magnifique et ça fonctionne SUPER !

Je gère une association caritative et je sais bien qu'il faut éviter de fusionner des cellules avec Excel, mais parfois, nous n'avons pas le choix.
J'ai donc copié votre formule magique dans mon fichier, mais est-ce que je pourrais l'utiliser pour d'autres onglets où j'ai le même problème ?

Un tout grand MERCI à vous et une toute belle journée.

Avec mes plus cordiales salutations.

Moussetictac

job75 · 30 Juin 2018

Re,

Moussetictac à dit:
je sais bien qu'il faut éviter de fusionner des cellules avec Excel

C'est une erreur de croire ça, dans la plupart des cas les cellules fusionnées ne sont pas gênantes, on en a la preuve ici...

Moussetictac à dit:
est-ce que je pourrais l'utiliser pour d'autres onglets où j'ai le même problème ?

Il suffit de mettre la macro dans ThisWorkbook :

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Target.MergeCells Then Exit Sub
Dim RH, L, CW, i&
Cancel = True
Application.ScreenUpdating = False
RH = Target.RowHeight
Target.Rows.AutoFit 'ajustement hauteur
If Target.RowHeight < RH Then Exit Sub 'un double-clic sur deux
L = Target.Width: CW = Target(1).ColumnWidth
Target.UnMerge 'défusionne
For i = 1 To 510 'largeur maximum d'une colonne 255
    Target(1).ColumnWidth = i / 2
    If Target(1).Width > L Then Target(1).ColumnWidth = (i - 1) / 2: Exit For
Next
Target(1).WrapText = True 'renvoi à la ligne
Target(1).Rows.AutoFit 'ajustement hauteur
Target(1).ColumnWidth = CW
Target.Merge 'refusionne
End Sub

Fichier (4).

A+

Moussetictac · 2 Juillet 2018

[RESOLU]

Rebonjour job75,

Mieux, ce n'est vraiment pas possible !

Un MERCI tardif mais sincère pour votre précieuse aide.

Une toute belle journée et meilleures salutations.

Moussetictac

Marcus275? · 5 Janvier 2022

Bonjour job 75,
Je cherche comment mettre automatiquement la hauteur d'une ligne fusionnée en fonction du texte contenu dans cette cellule.
Lorsque je recopie le code VBA sur ma feuille excel, je n'arrive pas au bon résultat. est ce le fait qu'il ya 2 code sur la même feuille?, ou deux codes double click?

jcf6464 · 5 Janvier 2022

Bonjour job 75,Marcus275?,

chez moi cela fonctionne en mettant le code au bon endroit,
Normal que cela ne marche pas tu n'a pas mis le code Job75 a sa place dans ThisWorbook de ton classeur

bonne continuation jcf

Marcus275? · 5 Janvier 2022

ok, ça fonctionne, merci beaucoup

Linda42 · 19 Octobre 2022

Bonjour JOB75
J'ai tenté d'appliquer ton code VBA à mon fichier, cela fonctionne mais quand je double clique, cela agrandi trop la ligne au lieu de l'ajuster automatiquement.
De plus j'aimerais que l'ajustement automatique se fasse au moment ou la saisie est terminé et que l'on passe à une autre cellule (tabulation ou entrée) car avec votre code c'est en double cliquant qu'elle s'ajuste il me semble.

Par ailleurs, dans un deuxième temps je souhaite rajouter d'autre feuille mais limiter un max la taille du fichier qui sera amener à être utiliser par plusieurs collaborateurs (je souhaite éviter une lourdeur à l'ouverture ou à l'envoi). si vous avez des astuce, je suis prenneuse.

Merci pour votre aide
Linda

job75 · 19 Octobre 2022

Bonjour Linda42, le forum,

Le dossier compressé est vide.

A+

Linda42 · 19 Octobre 2022

job75 à dit:
Bonjour Linda42, le forum,

Le dossier compressé est vide.

A+

Oops

Linda42 · 19 Octobre 2022

Ci-joint une version allégé

job75 · 19 Octobre 2022

Quelles cellules de quelles feuilles voulez-vous agrandir ?

XL 2013 Ajustement automatique hauteur de ligne

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Discussions similaires