Largeur de colonne en points V3.0

[patricktoulon]

re
tiens je te propose un truc
de faire un resize une cel par rapport au nombre de caractères + le font.size
(attention seulement avec quelque font.name pas tous !!!)

j'ai donc un peu repris ta fonction

Sub test3()
    Dim nbcaracter#, X#
    nbcaracter = 10.5
    With [A1]
        .Font.Size = 11
        .ColumnWidth = CDec(nbcaracter)
        X = GetSizeByPointsToChars([A11], .Width)
        .Offset(, 1) = "nombre de caracteres demandé " & nbcaracter
        .Offset(1, 1) = "rattrapage pour font size   à :" & X
        .ColumnWidth = X
        .Value = Application.Rept("a", nbcaracter)
    End With

    With [F1]
        .Font.Size = 15
        .ColumnWidth = CDec(nbcaracter)
        X = GetSizeByPointsToChars([F1], .Width)
        .Offset(, 1) = "nombre de caracteres demandé " & nbcaracter
        .Offset(1, 1) = "rattrapage pour font size   à :" & X
        .ColumnWidth = X
        .Value = Application.Rept("a", nbcaracter)
    End With

End Sub

Public Function GetSizeByPointsToChars!(ByRef Rng As Range, w!)
    Dim w0!, w1!, w2!, k1!, k2!, k3!
     w0 = Rng.Width
    ' Calcul des constantes
    Rng.ColumnWidth = 20: w1 = Rng.Width
    Rng.ColumnWidth = 40: w2 = Rng.Width
    k2 = (w2 - w1) / 20: k3 = w1 - k2 * 20: k1 = k2 + k3
    ' Restitution de la largeur initiale de la colonne rng
    If w0 <= k1 Then
        Rng.ColumnWidth = w0 / k1 * (Int((Rng.Font.Size / 11)))
    Else
        Rng.ColumnWidth = (w0 - k3) / k2 * (Int((Rng.Font.Size / 11)))
    End If
    ' Valeur de la fonction
    If w <= k1 Then
        PointsToChars = (w / k1) * (Rng.Font.Size / 11) - 0.75  '0.75 ou 1.2 c'est le margin left imuable
    Else
        PointsToChars = ((w - k3) / k2) * (Rng.Font.Size / 11) - 0.75 '0.75 ou 1.2 c'est le margin left imuable
    End If
End Function

 

[Katido]

Bonjour,
J'ai surtout essayé toutes sortes de largeurs (0,1 à 2850 points) et toutes de polices normales de taille 6 à 48. Et ça marche dans tous les cas.
Dans la mesure évidemment où la valeur ramenée par la fonction ne dépasse pas 255, puisque ColumnWidth n'accepte pas de valeur plus grande. Ce qui peut arriver avec de petites polices et de grandes colonnes, par exemple Size=6 et largeur = 1300 points). Mais là non plus je n'y peux rien, c'est une limite Excel.
Peux-tu STP m'envoyer un cas où ça ne marche pas.
Je rappelle que la police "normale" est celle qui est spécifiée dans les options : Fichier/Options/Générales/Lors de la création des classeurs/.

 

[Katido]

Le but est que ça marche quelle que soit la "police normale" et sans avoir à la connaitre. Le contenu et la police courante des colonnes n'ont rien à voir.

 

[patricktoulon]

re
bonjour kadido
a ben chez moi si j'ajoute pas * (Rng.Font.Size / 11)
ca ne fonctionne que sur font size 11 et le font name d'origine

autre que 11 et autre que le font d'origine le dit nombre de caractères ne rentre pas
ma fonction basé sur la tienne et elle est est faite pour ça justement
tu envoie le nombre de caractères et ça te dimensionne la cellule(pareil que toi à 1 poil près) mais ca prends en compte le font size
la théorie
pour une largeur de 14.4 caractères
c'est columnwidth=14.4 *(le font size/11)'pour certains fontname pas tous

je te laisse développer tes fonctions j’espère que tu va t'attaquer au rowsheight et autre encore

je serais curieux de remplacer ton code par autofit sur une cellule masqué ( en dehors de l’écran ) et d'en récupérer le columnwidth

 

[patricktoulon]

Le but est que ça marche quelle que soit la "police normale" et sans avoir à la connaitre. Le contenu et la police courante des colonnes n'ont rien à voir.

??????????????????????????????????????????????

fait moi plaisir va fair un tour du coté de DVP(developpez.com) la discussion tu devrais la retrouver je l'ai retrouvé hier

 

[Katido]

Tu ne sembles pas faire la différence entre la police normale (par défaut lors de l'ouverture d'un nouveau classeur) et la police courante des cellules...

 

[patricktoulon]

re chez moi c'est la même

 

[Katido]

Je viens d'essayer ta modif avec ce petit test :

Sub test10()
Dim w!, texte$
With [A1]
For w = 10 To 90 Step 10
.ColumnWidth = PointsToChars(w)
texte = texte & "largeur souhaitée =" & w & " largeur obtenue PTC =" & .Width & vbCrLf
.ColumnWidth = GetSizeByPointsToChars([A1], w)
texte = texte & "largeur souhaitée =" & w & " largeur obtenue GSBPTC =" & .Width & vbCrLf
Next
Debug.Print texte
End With
End Sub

Résultat : PointsToChars() est toujours juste et GetSizeByPointsToChars() est toujours faux
Voici le résultat pour Calibri 18 :

largeur souhaitée =10 largeur obtenue PTC =9,75
largeur souhaitée =10 largeur obtenue GSBPTC =9,75
largeur souhaitée =20 largeur obtenue PTC =20,25
largeur souhaitée =20 largeur obtenue GSBPTC =26,25
largeur souhaitée =30 largeur obtenue PTC =30
largeur souhaitée =30 largeur obtenue GSBPTC =42,75
largeur souhaitée =40 largeur obtenue PTC =39,75
largeur souhaitée =40 largeur obtenue GSBPTC =59,25
largeur souhaitée =50 largeur obtenue PTC =50,25
largeur souhaitée =50 largeur obtenue GSBPTC =75,75
largeur souhaitée =60 largeur obtenue PTC =60
largeur souhaitée =60 largeur obtenue GSBPTC =91,5
largeur souhaitée =70 largeur obtenue PTC =69,75
largeur souhaitée =70 largeur obtenue GSBPTC =108
largeur souhaitée =80 largeur obtenue PTC =80,25
largeur souhaitée =80 largeur obtenue GSBPTC =124,5
largeur souhaitée =90 largeur obtenue PTC =90
largeur souhaitée =90 largeur obtenue GSBPTC =141

et pour Calibri 9 :

largeur souhaitée =10 largeur obtenue PTC =9,75
largeur souhaitée =10 largeur obtenue GSBPTC =2,25
largeur souhaitée =20 largeur obtenue PTC =20,25
largeur souhaitée =20 largeur obtenue GSBPTC =12,75
largeur souhaitée =30 largeur obtenue PTC =30
largeur souhaitée =30 largeur obtenue GSBPTC =21
largeur souhaitée =40 largeur obtenue PTC =39,75
largeur souhaitée =40 largeur obtenue GSBPTC =29,25
largeur souhaitée =50 largeur obtenue PTC =50,25
largeur souhaitée =50 largeur obtenue GSBPTC =37,5
largeur souhaitée =60 largeur obtenue PTC =60
largeur souhaitée =60 largeur obtenue GSBPTC =45,75
largeur souhaitée =70 largeur obtenue PTC =69,75
largeur souhaitée =70 largeur obtenue GSBPTC =54
largeur souhaitée =80 largeur obtenue PTC =80,25
largeur souhaitée =80 largeur obtenue GSBPTC =62,25
largeur souhaitée =90 largeur obtenue PTC =90
largeur souhaitée =90 largeur obtenue GSBPTC =70,5

Bref, il ne faut pas faire intervenir la taille de police des cellules (et d'ailleurs toutes les cellules d'une colonne n'ont pas forcément la même police).
De plus, il ne faut pas retirer 0,75 car ce n'est pas un "margin left" et ce faisant tu introduis une erreur de plus (et même un plantage pour une valeur nulle GetSizeByPointsToChars([A1], 0)

J'en reste donc à ma fonction initiale qui jusqu'à maintenant fonctionne très bien.

 

[patricktoulon]

d'accords donc si je veux me servir de ta fonction il faut que je reste en font 11 points et en "calibri"

tu sais ce que la propriété columnwidth veut dire au moins ?
pour info je sais pas si tu le savais
elle est censé faire ce que ta fonction fait en font normal et 11
même si je te l'accorde c'est des dimension fausses
quand tu fait [A1].columnwidth=10 tu demande une largeur de 10 caractères
.width= points
.columnwidth= nb caractères

 

[Katido]

d'accords donc si je veux me servir de ta fonction il faut que je reste en font 11 points et en "calibri"

Non, ça marche quelle que soit la police puisque ça n'a rien à voir avec, et les résultats précédents le prouvent

quand tu fait [A1].columnwidth=10 tu demande une largeur de 10 caractères

Oui, mais je ne veux pas 10 caractères (sinon pas besoin de la fonction), je veux 150 points. Et là, je ne sais pas a priori combien il faut de caractères pour avoir 150 points. C'est pour le savoir et uniquement pour ça que j'ai fait la fonction, qui calcule ce nombre à partir de 150. Tu saisis ?

Dans bon nombre d'applis, on se contente de la largeur par défaut ou on fait un autofit ou on ajuste la largeur manuellement au pif.
Mais si on veut imposer une largeur bien définie à certaines colonnes pour soigner la présentation et positionner correctement du texte dans des cellules par rapport à des images, des graphiques ou autres :
- soit on le fait à la main à partir de l'en-tête en recherchant le nb de "pixels" qui correspond à la largeur voulue (200 Pixels si on veut 150 points), puisqu'on dispose de l'info en nb de caractères et en pixels.
- soit on veut le faire par VBA et là on est coincé, puisqu'on ne dispose que du ColumnWidth qu'il faut renseigner en nb de caractères. D'où la fonction pour calculer ce nb de caractères à partir de 150.

 

[Katido]

Katido a mis à jour Largeur de colonne en points avec une nouvelle entrée de mise à jour:

Largeur de colonne en points

Voici une nouvelle version qui inclut :
1) la correction des "copier/coller" erronés dans le texte
2) l'ajout de la directive ByVal dans la fonction PointsToChars()
3) l'ajout de la Sub RangeSize() sur le même principe, mais d'utilisation plus simple et plus complète

Lire le reste de cette entrée de mise à jour...

 

[Qubik]

Bonjour @Katido ,
Comme tu me le demandes, voici la méthode que j'avais utilisé, elle aussi développée à partir d'infos glanées sur les forums, car c'est vrai que la gestion interne d'Excel pour définir la largeur des colonnes, qui se base sur la dimension de la police du style "standard", est un vrai casse tête pour les utilisateurs.

Dans mon cas, je utilisé cette routine pour créer des dessins techniques automatiques (layouts millimétrés) de produits éditoriaux, dessins pas précis au millimètre mais graphiquement bien clairs et avec les côtes.

Le procédure pour dimensionner la largeur de la colonne était la suivante (et désolé pour les noms de variables utilisés, je suis italien et en plus je travaille su MAC, chose qui rends les choses très, très compliquées et le passage par des forums obligatoire). Donc, merci Excel-Downloads et merci à toi Kartido.

PS, la méthode pour obtenir la largeur en millimètre de la colonne (qui est récupéré directement dans la première cellule de la colonne en question), n'est pas plus longue, mais beaucoup plus lente en exécution (quelques dizaines de colonnes à dimensionner). En plus ce code remonte à 5 ans, je ne me rappelle même plus d’où j'étais parti. Mais ça marche très bien (quoique moins bien que le tien) ;-)

Bonne journée et à bientôt !

Sub DimColonna(ColNo As Integer, mmLarg As Double)
     
    w = Application.CentimetersToPoints(mmLarg / 10)
    
    While Columns(ColNo + 1).Left - Columns(ColNo).Left - 0.1 > w
        Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth - 0.1
    Wend

    While Columns(ColNo + 1).Left - Columns(ColNo).Left + 0.1 < w
        Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth + 0.1
    Wend

End Sub

 

[Katido]

Merci pour ton retour.
Pas de problème pour comprendre le sens de Colonna, même si mes connaissances en italien sont très basiques. Je suis moi-même installé en Espagne avec mon amie allemande, je suis donc habitué aux traductions.

J'avais un temps utilisé une méthode similaire à la tienne, mais fonctionnant par dichotomie pour aller plus vite, surtout si la largeur initiale est très grande ou très petite par rapport à la largeur voulue.

Bonne journée !

 

[Qubik]

Oui effectivement, et comme tu le soulignes, c'est très lent quand la longueur initiale est très différente de celle voulue. Mais ce n'est pas mon cas, d’où cette version d'algorithme (qui reste bien plus lente que la tienne).
Ce qui est dommage est que dans l'affichage en mode page, Excel permets d’insérer les valeurs de colonne en millimètre et les répercute quasi à l'instant, ce qui veut dire qu'une routine au niveau machine existe, mais nous n'y avons pas accès en VBA. Du reste, si on enregistre une macro è partir de ces valeurs en millimètres, la macro résultante sera écrite toujours en unités colonne/caractères correspondantes... Quel dommage !
PS : vive l'Espagne !

 

[Katido]

dans l'affichage en mode page, Excel permets d’insérer les valeurs de colonne en millimètre et les répercute quasi à l'instant

Merci pour le tuyau, je n'avais jamais essayé le mode page !
On a en effet une graduation en cm, et on peut fixer la largeur en cm depuis cette graduation en tête de colonne et aussi depuis la commande "Largeur de colonne...". La commande "Largeur par défaut..." est elle aussi exprimée en cm.
Mais rien depuis VBA, c'est vraiment ballot.