请问通过VBA能否获取到单元格中字符串的高度？

shenlong2006

如下图，我想知道单元格中字符串占有的高度，以判断某个单元格的高度是否能够容下该字符串，能否通过VBA实现呢？

QLZ0602

干嘛用呢？

shenlong2006

QLZ0602 发表于 2014-5-13 12:34
干嘛用呢？

如下一段代码是在网上找到的解决合并单元格跨页打印的一段代码，但运行后发现存在问题，原因是有些合并单元格中的字数较多，当取消合并单元格时，单元格会自动调整行高来适应内容，造成运行后某些行的行高和原表格不一样，结果还是有些合并单元格出现跨页的现象，如果能知道原单元格中的字符串高度，预先调整行高以满足字符串的高度，就不会出现这种情况了；说的有点乱，下面把示例传上来，大家运行一下看看就能发现问题了：

跨页合并.rar (29.21 KB, 下载次数: 7)

2014-5-13 14:24 上传

点击文件名下载附件

Private Sub CommandButton1_Click()
    Dim DSht As Worksheet
    Dim PB As HPageBreak
    Dim StLine As Long
    Dim MidLine As Long
    Dim EdLine As Long
    Dim rng As Range
    Dim ColN As Integer
    Application.ScreenUpdating = False
   Sheets(1).Copy after:=Sheets(1)
    ActiveWindow.View = xlPageBreakPreview
    i = 1
    With ActiveSheet
            For Each PB In .HPageBreaks
             For ColN = 0 To 19
                'B列
                If PB.Location.Offset(-1, ColN).MergeArea.Address = PB.Location.Offset(0, ColN).MergeArea.Address Then
                    Set rng = PB.Location.Offset(-1, ColN).MergeArea
                    'Get StartLine and EndLine
                    StLine = rng.Cells(1).Row
                    MidLine = PB.Location.Row
                    EdLine = rng.Cells(rng.Cells.Count).Row
                    '取消合并
                    rng.UnMerge
                    '写入值
                    .Cells(MidLine, ColN + 1) = .Cells(StLine, ColN + 1).Text
                    '重新合并
                    .Range(.Cells(StLine, ColN + 1), .Cells(MidLine - 1, ColN + 1)).Merge
                    .Range(.Cells(MidLine, ColN + 1), .Cells(EdLine, ColN + 1)).Merge
                End If
               Next ColN
               i = i + 1
            Next
       .Range("A4").CurrentRegion.Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    End With
End Sub

xpw6061

单元格中字符串占有的高度可以间接得出,用autofit方法,使单元格的行高自动适应内容,然后得到单元格的行高就是整个字符的高度了

shenlong2006

xpw6061 发表于 2014-5-13 15:08
单元格中字符串占有的高度可以间接得出,用autofit方法,使单元格的行高自动适应内容,然后得到单元格的行高就 ...

这个方法对于合并单元格就不管用了