[Résolu]Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

[mdidish]

Bonjour

J'ai un problème concernant la largeur des colonnes :
- dans mon classeur, toutes les colonnes ont une largeur de "2"
- je pensais que 6 cellules fusionnées auraient une largeur de "12", et donc contiendrait autant de texte qu'une cellule de largeur "12"
- or ce n'est pas le cas, une colonne de 12 est moins large que 6 colonnes de 2.

Ce problème s'intègre dans l'écriture d'une macro pour ajuster automatiquement la hauteur de cellules fusionnées avec retour à la ligne.
Je joins un fichier test dans lequel les cellules fusionnées dont la hauteur doit s'ajuster automatiquement sont en A2, F5, C7. J'ai écrit cette macro dans le code de la feuille, qui fonctionne presque sauf quand le nombre de caractères est limite (la hauteur de ligne étant alors trop grande :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Targe_2 As Range
    
On Error GoTo errorHandler
    
If Not Intersect(Target, Range("A2")) Is Nothing Or Not Intersect(Target, Range("F5")) Is Nothing Or Not Intersect(Target, Range("C7")) Is Nothing Then
    Set Target_2 = Worksheets("Résumé").Range("DD1000") ' définir une cellule hors du tableau
    Hauteur_T2 = Target_2.RowHeight
    Largeur_T2 = Target_2.ColumnWidth
    Target.MergeArea.WrapText = True
    Target_2.MergeArea.WrapText = True

    Target_2.Font.Name = Target.Font.Name
    Target_2.Font.Size = Target.Font.Size
    Target_2.ColumnWidth = Target.MergeArea.Columns.Count * Range("A1").ColumnWidth
    Target_2.Value = Target

    Target_2.Rows.AutoFit
    Target.RowHeight = Target_2.RowHeight

    Target_2.Clear
    Target_2.RowHeight = Hauteur_T2
    Target_2.ColumnWidth = Largeur_T2
End If

Exit Sub

errorHandler:
Set Target_2 = Worksheets("Résumé").Range("DD1000") ' définir une cellule hors du tableau
Target.RowHeight = Target_2.RowHeight

End Sub

Comment connaître la largeur exacte des cellules fusionnées ?

Merci

 

[Dranreb]

Re : Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

Franchement je ne sais plus. Moi non plus je ne fusionne jamais horizontalement: Cadrage à droite sur la cellule de droite, à gauche sur celle de gauche ou centrer sur plusieurs colonne me suffisent. Si l'imposition d'un ColumnWidth ne donne pas le même résultat sur des cellules selon qu'elles soient fusionnées ou non, il ne reste plus qu'à défusionner avant de le faire et refusionner ensuite.

 

[Modeste geedee]

Re : Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

Bonsour®

Normalement le Width d'une plage doit être égal à la somme des Width des colonnes qui la composent. Normalement c'est la différence entre les Left des cellules.

c'est précisément le cas... mais en VBA l'unité est le point...
à tester dans un module de feuille sur des cellules fusionnées et non fusionnées

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target.Address _
& Chr(10) & Target.Cells.Columns.Count & " colonne(s) par " & Target.Cells.Rows.Count & " ligne(s)" _
& Chr(10) & "larg : " & Target.Width & " x  haut : " & Target.Height _
& Chr(10) & "Pos : " & Target.Left _
& Chr(10) & "(Un point correspond à 1/72 pouce)" _
, vbInformation, "Références en points"
End Sub

pour ce qui est des diverses unités utilisées par EXCEL c'est en effet un peu la gabbegie, si l'on ne connait pas ceci :
Conversion des unit

 

[Modeste geedee]

Re : Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

Bonsour®
petit aparté pour connaitre la largeur d'un texte (pas de la cellule)

Ce lien n'existe plus

 

[mdidish]

Re : Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

Merci Modeste geedee pour ces liens ainsi que ton code. Je vais regarder plus précisément ce soir, mais ça semble effectivement être sur la bonne voie.
En tout cas merci à tous pour vos aides.

 

[mdidish]

Re : Largeur exacte d'une colonne et ajustement automatique de cellules fusionnées

Finalement voici mon code final qui est le plus précis (en fait le ratio .Width et .ColumnWidth n'est pas tout à fait constant, voir ce lien pour plus de précision) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Targe_2 As Range
On Error GoTo errorHandler

' définir une cellule hors du tableau
Set Target2 = Worksheets("Résumé").Range("DD1000")
    
If Not Intersect(Target, Range("J27")) Is Nothing Or Not Intersect(Target, Range("H28")) Is Nothing Or Not Intersect(Target, Range("I29")) Is Nothing Or Not Intersect(Target, Range("A31")) Is Nothing Then
    
    Hauteur_T2 = Target2.RowHeight
    Largeur_T2 = Target2.ColumnWidth
    Target.MergeArea.WrapText = True
    Target2.MergeArea.WrapText = True
    Target2.Font.Name = Target.Font.Name
    Target2.Font.Size = Target.Font.Size

    If Target.MergeCells Then
        With Target2
            For j = 1 To 3
                .ColumnWidth = Target.MergeArea.Width / .Width * .ColumnWidth
            Next j
        End With
    End If

    Target2.Value = Target
    Target2.Rows.AutoFit
    Target.RowHeight = Target2.RowHeight

    Target2.Clear
    Target2.RowHeight = Hauteur_T2
    Target2.ColumnWidth = Largeur_T2

End If

Exit Sub

errorHandler:
Set Target2 = Worksheets("Résumé").Range("DD1000")
Target.RowHeight = Target2.RowHeight

End Sub

A noter que si les cellules A1 à C1 sont fusionnées, et qu'on modifie A1 :
- dans un module Feuille Worksheet_SelectionChange, Target désigne A1:C1
- dans un module Feuille Worksheet_Change, Target désigne A1

Merci à chacun pour sa contribution.