I wanted to get an Excel table with fixed dimensions (in millimeters). But Excel works with different units, not to say that column width and row heights are handled completely different.
Searching the web, did get to a viable code, but it was extremelly slow (when a bunch of resizes has to be performed). So I tunned the code a bit, with a first approximation to the final width objective, so less resize operations had to be carried out.
Here is the code, hope it helps:
Option Explicit Sub ChangeWidthAndHeight() SetColumnWidthMM 1, 10 SetRowHeightMM 1, 10 End Sub Private Sub SetRowHeightMM(ByVal RowNo As Long, _ ByVal mmHeight As Integer) ' changes the Row Height to mm Height With ActiveSheet If RowNo < 1 Or RowNo > .Rows.Count Then Exit Sub End With With Application .ScreenUpdating = False ActiveSheet.Rows(RowNo).RowHeight = .CentimetersToPoints(mmHeight / 10) .ScreenUpdating = True End With End Sub Private Sub SetColumnWidthMM(ByVal ColNo As Long, _ ByVal mmWidth As Integer) ' changes the column width to mm Width ' Column widths are not really measured in any "unit" as such. ' Instead, the number refers to the number of characters which can be displayed in the column. ' For variable width fonts such as Arial, the "0" character is used. ' In VBA, the ColumnWidth property uses this measure of width, and the Width property uses Points. ' 1 inch = 72 points ' 1 pointH = 1/72 inches. ' 1 pointH = 0.0353 centimeters (or .353 millimetre) ' 1 pointH = ... x pixels Dim w As Single Dim wSize As Single With ActiveSheet If ColNo < 1 Or ColNo > .Columns.Count Then Exit Sub End With Application.ScreenUpdating = False w = Application.CentimetersToPoints(mmWidth / 10) With ActiveSheet wSize = (.Columns(ColNo + 1).Left - .Columns(ColNo).Left) ' First approximation: With .Columns(ColNo) .ColumnWidth = .ColumnWidth * (w / wSize) End With While .Columns(ColNo + 1).Left - .Columns(ColNo).Left - 0.1 > w '.Columns(ColNo).ColumnWidth = .Columns(ColNo).ColumnWidth - wMove With .Columns(ColNo) 'Debug.Print .ColumnWidth .ColumnWidth = .ColumnWidth - 0.1 End With Wend While .Columns(ColNo + 1).Left - .Columns(ColNo).Left + 0.1 < w With .Columns(ColNo) 'Debug.Print .ColumnWidth .ColumnWidth = .ColumnWidth + 0.1 End With Wend End With Application.ScreenUpdating = True End Sub