OVH Cloud OVH Cloud

Largeur des colonnes

3 réponses
Avatar
Pierre-Yves Ste-Marie
Existe-t-il une table pour définir la largeur des colonnes selon une largeur
précice comme par exemple 1 cm

Merci

3 réponses

Avatar
Jean Francois Galland
Pierre-Yves Ste-Marie wrote:

Existe-t-il une table pour définir la largeur des colonnes selon une largeur
précice comme par exemple 1 cm

Merci




Evident ! ;-)

La largeur exprime combien de caracteres zero ( 0 ), non gras, non italiques,
dans la police normale, on peut faire rentrer dans la cellule.


Apres ca se complique sacrement, car comme dirait Fernand Raynaud, ca depend.
Ca depend de la taille de la police par defaut. Donc a la fois de la taille
et de la police par defaut.

Le plus simple est de prendre la macro sur le site de microsoft :
http://support.microsoft.com/default.aspx?scid=kb;en-us;213422

Cette macro travaille par approximation successives car si la largeur
de la colonne est dans le flou artistique, la largeur des cellules
qui composent la colonne est en "points" (un point = a peu pres
1/72 de pouce ).


Le tableau de conversion ci dessous est obtenu en modifiant cette
macro pour faire une boucle :

CM Larg Colonne
1 5.00
2 10.57
3 15.57
4 21.00
5 26.57
6 32.00
7 37.00
8 42.57
9 48.00
10 53.57
11 59.00
12 64.57
13 69.57
14 75.00
15 80.57
16 86.00
17 91.57
18 96.57
19 102.00
20 107.57


La macro de microsoft a ete modifiee comme suit pour
obtenir ce tableau ( executer BuildTable) :


Function ColWidthCM(cm As Single) As Single
Dim points As Integer, savewidth As Integer
Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
Dim Count As Integer

' Turn screen updating off.
Application.ScreenUpdating = False
' Convert the inches entered to points.
points = Application.CentimetersToPoints(cm)
' Save the current column width setting.
savewidth = ActiveCell.ColumnWidth
' Set the column width to the maximum allowed.
ActiveCell.ColumnWidth = 255
' If the points desired is greater than the points for 255
' characters...
If points > ActiveCell.Width Then
' Display a message box because the size specified is too
' large and give the maximum allowed value.
MsgBox "Width of " & cm & " is too large." & Chr(10) & _
"The maximum value is " & _
Format(ActiveCell.Width / 28.3464566929134, _
"0.00"), vbOKOnly + vbExclamation, "Width Error"
' Reset the column width back to the original.
ActiveCell.ColumnWidth = savewidth
' Exit the Sub.
Exit Function
End If
' Set the lowerwidth and upper width variables.
lowerwidth = 0
upwidth = 255
' Set the column width to the middle of the allowed character
' range.
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
' Set the count to 0 so if it can't find an exact match it won't
' go on indefinitely.
Count = 0
' Loop as long as the cell width in is different from width
' wanted and the count (iterations) of the loop is less than 20.
While (ActiveCell.Width <> points) And (Count < 20)
' If active cell width is less than desired cell width.
If ActiveCell.Width < points Then
' Reset lower width to current width.
lowerwidth = curwidth
' set current column width to the midpoint of curwidth
' and upwidth.
Selection.ColumnWidth = (curwidth + upwidth) / 2
' If active cell width is greater than desired cell width.
Else
' Set upwidth to the curwidth.
upwidth = curwidth
' Set column width to the mid point of curwidth and lower
' width.
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
' Set curwidth to the width of the column now.
curwidth = ActiveCell.ColumnWidth
' Increment the count counter.
Count = Count + 1
Wend
ColWidthCM = ActiveCell.ColumnWidth
ActiveCell.ColumnWidth = savewidth
End Function

Sub BuildTtable()
Dim row As Long

For row = 1 To 20
Cells(row + 1, 1).Value = row
Cells(row + 1, 2).Value = ColWidthCM(CSng(row))
Next row
Cells(1, 1).Value = "CM"
Cells(1, 2).Value = "Larg Colonne"
End Sub

Avatar
Jean Francois Galland
PS : j'ai (peut etre abusivement) suppose que c'etait la
largeur imprimee.

Sur l'ecran je n'en sais rien et je crains que ce soit
encore plus complique.

Bonne Journee
Jean Francois
Avatar
Michel Pierron
Bonsoir Pierre-Yves;
La correspondance est celle-ci (environ 0,5163636 points par mm):
Largeur (mm) / Largeur (points)
5 2
10 4,71
15 7,43
20 10,14
25 12,86
30 15,57
35 18,29
40 21
45 23,71
50 26,29

Pour établir la table:
Sub LargeurEnMM()
Dim i%, x%, iVal#
iVal = Columns(1).ColumnWidth
For i = 5 To 50 Step 5
x = x + 1
Cells(x, 1) = i
Cells(x, 2) = SetColumnWidth(i)
Next i
Columns(1).ColumnWidth = iVal
End Sub

Private Function SetColumnWidth(MM As Integer) As Double
Dim lr As Single
Application.ScreenUpdating = False
lr = Application.CentimetersToPoints(MM / 10)
While Columns(1).Width > lr
Columns(1).ColumnWidth = Columns(1).ColumnWidth - 0.1
Wend
While Columns(1).Width < lr
Columns(1).ColumnWidth = Columns(1).ColumnWidth + 0.1
Wend
SetColumnWidth = Columns(1).ColumnWidth
End Function

MP


"Pierre-Yves Ste-Marie" a écrit dans le message de
news:uXCCd.7003$
Existe-t-il une table pour définir la largeur des colonnes selon une
largeur

précice comme par exemple 1 cm

Merci