Bonjour Stéphane, Ti, Jean-Marie et le Forum.
Ci-dessous fichier récupéré chez un collègue de travail du service courrier. Le nom de l'auteur n'y figure pas.Si il se reconnaît, qu'il se fasse connaître pour le remercier.
Rendons à César, ce qui appartient à César
Bon week-end à tous
Sub colonnesEnCentimetres()
Dim cm As Integer, points As Integer, savewidth As Integer
Dim count As Integer
Application.ScreenUpdating = False
cm = Application.InputBox("entrer la largeur de la colonne en cms", "Largeur de la colonne souhaitée", Type:=1)
If cm = False Then Exit Sub
points = Application.CentimetersToPoints(cm)
savewidth = ActiveCell.ColumnWidth
ActiveCell.ColumnWidth = 255
If points > ActiveCell.Width Then
MsgBox "la largeur de" & cm & "est trop large" & Chr(10) & "la valeur maxi est de " & Format(ActiveCell.Width / 28.3464566929134, _
"0.00"), vbOKOnly + vbExclamation, "largeur non valable"
ActiveCell.ColumnWidth = savewidth
Exit Sub
End If
lowerwidth = 0
upwidth = 255
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
count = 0
While (ActiveCell.Width <> points) And (count < 20)
If ActiveCell.Width < points Then
lowerwidth = curwidth
Selection.ColumnWidth = (curwidth + upwidth) / 2
Else
upwidth = curwidth
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
curwidth = ActiveCell.ColumnWidth
count = count + 1
Wend
End Sub
'2) pour les lignes (nettement plus court car lignes et colonnes n'ont
'pas, au départ, les mêmes unités de mesure
Sub lignesEnCentimetres()
Dim cm As Integer
cm = Application.InputBox("entrer la hauteur de la ligne en centimetres", "Hauteur de la ligne souhaitée", Type:=1)
If cm Then
Selection.RowHeight = Application.CentimetersToPoints(cm)
End If
End Sub