Hello everyone
I have the following code the change the column width to be by centimeter instead of points
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
' Turn screen updating off.
Application.ScreenUpdating = False
' Ask for the width in inches wanted.
cm = Application.InputBox("Enter Column Width in Centimeters", _
"Column Width (cm)", Type:=1)
' If cancel button for the input box was pressed, exit procedure.
If cm = False Then Exit Sub
' 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 Sub
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
End Sub
I tested the code >> selected B4 cell >> put 5 in the input box
I navigated to view tab then Page layout
Right click on column B >> I found the width is 5.21cm ???!!
How to get exactly the width in centimeter??
Bookmarks