Predict text wrapping in cell

The problem: I use VBA to populate MS Excel 2000 cells with text. The column has a fixed width (should not be changed due to layout) and the wordwrap property is set to true so the text wraps over multiple lines if wider than the column. Unfortunately, the row-height do开发者_开发技巧 not always get updated accordingly. I need a way to predict if the text wraps over multiple lines so I can "manually" adjust the height.

I want to do something like this:

range("A1").value = longText  
range("A1").EntireRow.RowHeight = 14 * GetNrOfLines(range("A1"))  

How do I write the function GetNrOfLines?

I can't rely on number of characters since the font is not mono-space. Sometimes the cells I'm writing to are merged with other cells so Autofit doesn't work. Please remember that I'm working in Excel 2000. Suggestions?

You say that AutoFit won't work because the cell is sometimes merged (with the cell above or below, I presume).

However, you could create a temporary worksheet, copy the content and formatting (column width, font, size, etc.) of the cell over there, then use AutoFit to get the ideal row height? Then delete the temporary worksheet again. (If you're doing lots of cells at once, then obviously you can use the temporary worksheet for them all without re-creating it each time).

Unfortunately, I haven't found a good solution. The problem originates in a bug in Excel 2000. I do not know if it also applies to later versions.

The problem manifest it self when merging cells horizontally. Row height fails to auto adjust when you have merged cells.

The following example code shows the problem

Dim r As Range
Set r = Sheet1.Range("B2")
Range(r, r(1, 2)).Merge
r.Value = ""
r.Value = "asdg lakj dsgl dfgjdfgj dgj dfgj dfgjdgjdfgjdfgjd"
r.WrapText = True
r.EntireRow.AutoFit

In this case r.EntireRow.AutoFit will not take into account that the text spans over several rows, and adjust the height as if it was single line of text.
You'll have the same problem when doing manual autofit (double clicking on the row-height-adjuster in the sheet) to a row that has merged cells and word wrap.

A solution (as suggested by Gary McGill ) is to use an unrelated sheet. Set the column width to match the full with of the merged cells. Copy the text, with the same formating. Let the cell auto-adjust and use that cells values.

Here follows a simplified example:

Public Sub test()

    Dim widthInPoints As Double
    Dim mergedCells As Range
    Set mergedCells = Sheet1.Range("B2:C2")
    widthInPoints = mergedCells.width

    Dim testCell As Range
    Set testCell = Sheet2.Range("A1")
    testCell.EntireColumn.columnWidth = ConvertPointsToColumnWidth(widthInPoints, Sheet2.Range("A1"))
    testCell.WrapText = True
    testCell.Value = mergedCells.Value
    'Text formating should be applied as well, if any'

    testCell.EntireRow.AutoFit

    mergedCells.EntireRow.rowHeight = testCell.rowHeight
End Sub

Private Function ConvertPointsToColumnWidth(widthInPoints As Double, standardCell As Range) As Variant

    ConvertPointsToColumnWidth = (widthInPoints / standardCell.width) * standardCell.columnWidth

End Function

What about using the Range.Rows.AutoFit method?

I have resolved this by inserting a shape into the worksheet, adding text, getting the shape's height, then deleting the shape.

Something like this for office 2007+:

Set tShape = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, someWidth, 0)
tShape.TextFrame.AutoSize = True
tShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
tShape.TextFrame.Characters.Text = myLongTextString

rowHeight = tShape.TextFrame2.TextRange.BoundHeight
tShape.Delete

For ofice 2003- the following seems to work:

Set tShape = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, someWidth, 0)
tShape.TextFrame.AutoSize = True
tShape.TextFrame.Characters.Text = myLongTextString

rowHeight = tShape.Height
tShape.Delete