0

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

我想做这样的事情：

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

如何编写函数 GetNrOfLines？

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

4

4 回答 4

0

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

于 2009-11-12T03:59:11.267 回答
0

您说 AutoFit 不起作用，因为有时会合并单元格（我想是在上方或下方的单元格）。

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

于 2009-11-12T09:22:26.327 回答
0

不幸的是，我还没有找到一个好的解决方案。问题出在 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
于 2009-11-21T14:53:08.083 回答
0

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

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

对于office 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
于 2013-03-12T19:25:54.087 回答