Set column width by centimeter

[YasserKhalil]

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??

[mehmetcik]

http://www.excelhowto.com/how-to-set...in-cm-at-once/

[YasserKhalil]

Thanks for the link .. But it doesn't solve the problem
Even if I edit the column width manually in page layout view and then test the column width again I find it not exactly
For example : Be in page layout view >> right click column B >> Column width >> Put 3cm >> test the column width again you would find it 2.99 ..!!
That's weird or it is a matter of points and centimeters

Thanks for reply

[shg]

You can't set column widths precisely. The smaller you make the font size for style Normal, though, the more accurate you can get.

[YasserKhalil]

Thanks for reply
I have applied the smallest font size of style normal .. and still have the same problem
I need VBA code that achieve that task .. just to adjust column width by centimeters and after that if I checked it (I don't desire to see different results)

[shg]

Maybe you can adapt this:

Sub test()
  SquareCells Selection, 0.5, 0.955, 1.024
End Sub

Sub MakeSquareCells()
  SquareCells
End Sub

Function SquareCells(Optional r As Range, _
                     Optional ByVal fDim As Single = -1, _
                     Optional fHScal As Single = 1, _
                     Optional fVScal As Single = 1) As Single
  ' shg 2007

  ' Sets all cells in r (or the selection if r is omitted) to be
  ' approximately fDim x fDim (inches)

  ' Returns the actual aspect H/W

  ' fHScal and fVScal compensate for the printer; obtain by measuring

  Dim i             As Long
  Dim sDim          As String

  If fDim = -1 Then
    fDim = Application.InputBox(Prompt:="Cell size, in inches (0.01 to 5.5)?", _
                                Title:="Size?", _
                                Default:="1", _
                                Type:=1)
  End If
  fDim = 72 * fDim  ' convert to points
  If fDim < 0.01 Or fDim > 409 Then Exit Function

  If r Is Nothing Then Set r = Selection
  r.Select

  For i = 1 To 4
    r.Columns.ColumnWidth = r.Columns(1).ColumnWidth / r.Columns(1).Width * fDim * fHScal
    r.Rows.RowHeight = fDim * fVScal
  Next i

  Debug.Print "SquareCells: " & _
              "  Actual Height = " & Format(r.Columns(1).Width / 72, "0.000") & _
              "  Actual Width  = " & Format(r.Rows(1).Height / 72, "0.000") & _
              "  Aspect = " & Format(r.Columns(1).Width / r.Rows(1).Height, "0.000")
End Function

[YasserKhalil]

Great ... Thanks a lot for sharing it
Does this function deal with inches only ? How can be edited to deal with the centimeter?
Sorry for disturbing you

[shg]

Yasser, if you've written any of the code that you've posted lately, I am confident you can manage to convert from inches to centimeters.

[YasserKhalil]

In fact it is not my code ...I just was trying to search to find a solution to the problem ...
I think it is a matter of conversion between units (but I'm not expert at this conversion at all)

[skywriter]

Inches to cm

cm = inches/0.39370

[YasserKhalil]

I tried to change again (converting cm to points)

fDim = 28.3464566929134 * fDim

I tested it by putting 5 in the inputbox and After testing I found the row height is 5cm (It's ok) but the column width was 5.11 cm) ...

[YasserKhalil]

Thanks a lot Mr. Bruce for sharing
I tried to change to this line

fDim = 72 * (fDim / 0.3937)

But nothing changed when testing the code
Thanks for reply

[skywriter]

If you want fdim to be in points and there are 72 points to an inch and you are inputting centimeters I would think it would be.

fDim = 72 * fDim / 2.540005

[YasserKhalil]

I tested that change also and still the same .. Row height is 5 cm while column width is 5.11cm

[shg]

I retract what I said about Normal's font size affecting affecting the resolution with which you can set column width. On my laptop, the step size is always 0.6 points. That may be affected by monitor resolution or other factors.

[mikerickson]

Perhaps something like

Dim desiredCentimeters As Double
Dim desiredWidth As Double
Dim currentWidth As Double, currentColWidth As Double
Dim desiredColWidth As Double

desiredCentimeters = Application.InputBox("how many centimeters?", Default:="5", Type:=1)

desiredWidth = Application.CentimetersToPoints(desiredCentimeters)

With Range("T1")
    currentWidth = .Width
    currentColWidth = .ColumnWidth
    desiredColWidth = currentColWidth / currentWidth * desiredWidth
    .ColumnWidth = desiredColWidth
End With

[Keebellah]

@mikerikson: its perfect for 5cm but if you enter 10 it becomes 11
The problem is the way Excel calculates the dimensions
The width is the number of characters based upon Arial 10.

This article I found http://excelsemipro.com/2010/10/colu...xcel-versions/
explains it but does not actually solve it.

You would have to create a relational formula

[mikerickson]

That code assumes that ColumnWidths is linear, i.e. a cell with .ColumnWidth = 3.2 is 3.2 times wider than a cell with .ColumnWidth = 1

[karedog]

Is this gives a better result ?

Sub SetColumnWidth_in_cm()
  Dim shp As Shape, cell As Range, expectedWidth As Single, s As Single

  On Error Resume Next
     expectedWidth = Abs(CLng(InputBox("Enter desired column width in cm")))
     If Err.Number <> 0 Then Exit Sub
  On Error GoTo 0
  expectedWidth = Application.CentimetersToPoints(expectedWidth)
  Set cell = ActiveCell

  Application.ScreenUpdating = False
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, cell.Left, cell.Top, 10, 10)
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      For s = 0 To 255 Step 0.01
          cell.EntireColumn.ColumnWidth = s
          .Width = cell.Width
          If Abs(.Width - expectedWidth) < 0.05 Then Exit For
      Next s
      .Delete
    End With
  Application.ScreenUpdating = True
End Sub

[Keebellah]

@karedog: yous result is 5.25 cm and if you enter 10 the the result is 10.5 so there is 2.5 mm increment met 5 cm >
If I read all that's said about this it isn't easy.
I've given up but ... who knows, somebody might find the correct formula so that the OP is helped

[karedog]

Ok, second try :

Function Column_cm_point(param As Single) As Single
  Column_cm_point = 5.157073 * param - 0.86853
End Function

Sub Test()
  Columns("E").ColumnWidth = Column_cm_point(5)
  Columns("F").ColumnWidth = Column_cm_point(10)
  Columns("G").ColumnWidth = Column_cm_point(15)
End Sub

[Keebellah]

Real close:
5cm = 5cm
10cm = 10.1cm
15 = 15.2cm
This will go up the wider you get but I don't think the OP is looking for that.

Maybe the OP's drawing a floor plan

[mikerickson]

I'm thinking that if a difference of .2 cm is a problem, then Excel is being used as something other than a spreadsheet and that other platforms would be better for the purpose intended.

[Keebellah]

That's what I meant with the the OP was probably using Excel for a floor plan
I agree 200%

[mikerickson]

Hmmm. The ruler that is used to verify that the column widths are .2 off can also be used as a drafting tool.

(I know, "20th century thinking")

[YasserKhalil]

Thanks a lot everybody for all these ideas and solutions provided...
I tested Mr. mikerickson's code >> I entered 5cm and got 4.89 / tested 10cm and got 10cm
As for Mr. Karedog's code .. it took some time and when entered 5 cm I got 5.11
and the UDF function provided : 5cm I got 5.5cm ** 10 cm I got 11.09 ** 15 cm I got 16.64

It seems that it is complicated issue
I have done some search and expect it is concerned screen resolution and if we could deal with pixels and points according to API declarations ,there might be a solution
Thanks a lot for everyone who is sharing the issue

[mikerickson]

I'm thinking that the .1 or .11 difference is unavoidable.

I'm not sure if the results are being measured on a screen or on a print-out, but it wouldn't surprise me if that 1 mm is within the variation between manufacturers for this kind of application.

[YasserKhalil]

Hope to find solution for this issue
I think if we could calculate pixels through screen resolution and convert pixels to points or centimeters this may help

[thisoldman]

Trying to set fixed sizes in Excel can be frustrating. Row height is measured in pixels and points, nominally 1/72nd of an inch. Column width is set in pixels or by the number of zeros of the default font, often 8.43 zeros. Charts and other objects are measured in inches. At least, it's inches here in the United States.

This gets complicated even more by video driver capabilities, monitors where pixel resolution isn't square, and the worksheet magnification the user selects.

A 2004 blog post on Daily Dose of Excel suggests that setting column width may have to be done two or three times in a row for the column width to "stick" and become close to accurate.

http://dailydoseofexcel.com/archives...ths-in-points/

I think if one wants dimensions to be set accurately, one would have to translate the spreadsheet into a typesetting or CAD program. Even with that, dimensions would only be accurate for print, not for screen display.

[Keebellah]

You must also keep in mind that when you print it you cannot choose anything like fit to page etc because then the results on paper will be % of the actual size
Good luck

[karedog]

My last attempt (a dirty one) :

Private Sub SetColumnWidthCm(ParamArray param())
  'param = Pairs of column id & desired width, for example :
  '        SetColumnWidthCm "A",5,"B",10  --> Set Column A width = 5cm, Column B = 10cm
  '        SetColumnWidthCm 1,5,2,10      --> Set Column 1 width = 5cm, Column 2 = 10cm
  Dim oldMU As Long, cell As Range, i As Long, v

  oldMU = Application.MeasurementUnit: Set cell = ActiveCell
  Application.MeasurementUnit = xlCentimeters
  Application.ScreenUpdating = False
  ActiveWindow.View = xlPageLayoutView
      For i = LBound(param) To UBound(param) Step 2
          If IsNumeric(param(i)) Then v = Val(param(i)) Else v = param(i)
          Columns(v).Select
          SendKeys "+{F10}cc~" & param(i + 1) & "~", True
      Next i
  ActiveWindow.View = xlNormalView
  Application.ScreenUpdating = True
  Application.MeasurementUnit = oldMU: cell.Select
End Sub

Sub Test()
  SetColumnWidthCm "A", 1, "B", 2, "C", 5, 4, 10
End Sub

Bye Bye.gif

[YasserKhalil]

Thanks a lot Mr. Karedog
I tested the code...
Selected A1 >> Run the macro "Test"
The result:
No changes in columns widths
Some values were in range("A1:A8")
c
1
c
2
c
5
c
10

Any idea>>