Question

问题：我使用VBA用文本填充MS Excel 2000单元格。该列具有固定宽度（不应因布局而更改），并且wordwrap属性设置为true，因此如果文本宽于列，则文本将包裹多行。不幸的是，行高并不总是相应地更新。我需要一种方法来预测文本是否包裹多行，这样我就可以“手动”调整高度。

我想做这样的事情：

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

如何编写GetNrOfLines函数？

我不能依赖字符数，因为字体不是单字空格。有时我写的单元格与其他单元格合并，因此Autofit不起作用。请记住，我在使用Excel 2000。建议？

Answer 1

使用Range.Rows.AutoFit方法怎么样？

Answer 2

你说AutoFit不起作用，因为有时会合并单元格（我认为上面或下面是单元格）。

但是，您可以创建一个临时工作表，复制单元格的内容和格式（列宽，字体，大小等），然后使用AutoFit获得理想的行高？然后再次删除临时工作表。（如果你一次做了很多单元格，那么显然你可以使用临时工作表，而不必每次都重新创建它。）

Answer 3

不幸的是，我还没有找到一个好的解决方案。问题源于Excel 2000中的错误。我不知道它是否也适用于更高版本。

当水平合并单元格时，问题会显示出来。合并单元格时，行高无法自动调整。

以下示例代码显示了问题

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

在这种情况下，r.EntireRow.AutoFit不会考虑文本跨越多行，并调整高度，就像它是单行文本一样。
在手动自动调整（双击工作表中的行高调整器）到已合并单元格和自动换行的行时，您会遇到同样的问题。

解决方案（由Gary McGill建议）是使用不相关的纸张。设置列宽以匹配合并单元格的完整内容。复制文本，使用相同的格式。让单元格自动调整并使用该单元格值。

以下是一个简化示例：

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

Answer 4

我已经通过在工作表中插入一个形状，添加文本，获取形状的高度，然后删除形状来解决这个问题。

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

对于ofice 2003-以下似乎有效：

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

rowHeight = tShape.Height
tShape.Delete

预测文本环绕在单元格中

4 个答案: