Sub ColumnWidthInCentimeters().
Dim cm As Single, points As Integer, savewidth As Integer.
Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer.
Dim Count As Integer.
Application.ScreenUpdating = False.
Cm = Application.InputBox("Enter Column Width in Centimeters", _.
"Column Width (cm)", Type:=1).
If cm = False Then Exit Sub.
Points = Application.CentimetersToPoints(cm).
Savewidth = ActiveCell.ColumnWidth.
ActiveCell.ColumnWidth = 255.
If points > ActiveCell.Width Then.
MsgBox "Width of " & cm & " is too large." & Chr(10) & _.
"The maximum value is " & _.
Format(ActiveCell.Width / 28.3464566929134, _.
"0.00"), vbOKOnly + vbExclamation, "Width Error".
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.
