Function CreateWB(Optional strBookName As String = "", _
                  Optional intNumSheets As Integer =  3 )
    Dim intOrigNumSheets As Integer
    Dim wkbNew As Excel.Workbook, ratio As Integer, yside As Double, xside As Double, cm As Double
    Dim xlApp As Excel.Application
    Dim rngCurrentCell As Excel.Range

    Const XL_NOTRUNNING As Long =  429 

    On Error GoTo CreateNew_Err

    Set xlApp = GetObject(, "Excel.Application")

    intOrigNumSheets = xlApp.SheetsInNewWorkbook
    If intOrigNumSheets <> intNumSheets Then
        xlApp.SheetsInNewWorkbook = intNumSheets
    End If
    Set wkbNew = xlApp.Workbooks.add
    If Len(strBookName) =  0  Then strBookName = xlApp.GetSaveAsFilename
    wkbNew.SaveAs strBookName
    xlApp.SheetsInNewWorkbook = intOrigNumSheets

        ratio =  1 
        yside = (xlApp.Worksheets( 1 ).Cells.RowHeight /  2 )
        xside = yside /  10 
        xlApp.Worksheets( 1 ).Cells.ColumnWidth = xside / ratio
        xlApp.Worksheets( 1 ).Cells.RowHeight = yside / ratio
    wkbNew.Save
    xlApp.Quit
    Set xlApp = Nothing

CreateNew_End:
    Exit Function
CreateNew_Err:
    If err = XL_NOTRUNNING Then
        ' Excel is not currently running.
        Set xlApp = New Excel.Application
        Resume Next
    Else
        wkbNew.Close False
        Set wkbNew = Nothing
        xlApp.Quit
        Set xlApp = Nothing
    End If
    Resume CreateNew_End
    Resume
End Function

?createwb (currentproject.path & "test.xls")

?createwb(currentproject.path & "\test.xls")

Function textw()
   On Error GoTo textw_Error

Dim Шир As Single, Выс As Single, Fx As Single, Fy As Single
  Шир =  10  ' <= милиметры
  Выс =  10  ' <= милиметры
  Шир = Шир /  10 
  Выс = Выс /  10 
  Fy = Выс / Шир
  With ActiveCell
    .ColumnWidth = Шир
    Fx = .Width / .ColumnWidth
    .ColumnWidth = rng.Application.CentimetersToPoints(Шир) / Fx
    Fx = .Width / .ColumnWidth
    .RowHeight = .ColumnWidth * Fx * Fy
  End With

   On Error GoTo  0 
   Exit Function

textw_Error:
    MsgBox2 "Error " & err.NUMBER & " (" & err.Description & ") in procedure textw of Module ExcelMethods"
    Exit Function

End Function