patricktoulon
XLDnaute Barbatruc
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
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
VB:
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
Dernière édition: