Question

我正在尝试弄清楚如何在Excel单元格中将评论弹出设置为自动调整大小。仅使用AutoSize属性是不可接受的，因为它会将评论转换为单行。这是我的想法：

将AutoSize设为true。
使用单行计算面积评论的维度。
通过调整来计算新尺寸单行注释的区域为3x4宽高比（或任何方面比率看起来更好）。

这种方法的问题在于，对于较长的评论，尤其是包含换行符的评论，这会在底部处留下空格。

有没有办法调整评论高度所以没有（或者，至少没有太多）空格？就像检测评论的最后一个字母是否可见，如果不调整大小一样？或者使用其他东西？

通过反复试验，我几乎可以根据文本的数量（或者更确切地说，单行自动调整注释的长度或面积）来调整注释高度，这是关于0.7表示较短的注释，0.52表示较长的注释（使用默认字体/ etc）。但是投入换行符会使它变得更加复杂（我认为每个换行符约占文本的25％，不计算标题换行符）。我想让它更准确，更不易碎（如果它打破了不同的字体/等）。

如果有更好的方法？我对任何想法持开放态度，只要它不是一行（对于更长的评论），它不会留下大量不必要的空格，并且评论文本不会被裁剪（我不会注意文本是否通过Excel电子表格的边框裁剪到右边。

这是我的宏：

Sub AutoSizeCommentInSelectedCellTest()
    Dim cellComment As Comment  ' selected cell
    Dim area As Double          ' comment rectangle area

    Const MAX_COMMENT_WIDTH = 300

    ' Make sure we have a seected cell.
    If ActiveCell Is Nothing Then
        Exit Sub
    End If

    ' Make sure we have a comment in the selected cell.
    Set cellComment = ActiveCell.Comment

    If cellComment Is Nothing Then
        Exit Sub
    End If

    With cellComment
        With .Shape
            ' AutoSize will covert comment to a single line.
            .TextFrame.AutoSize = True

            ' If comment's width is shorter than max, we're done.
            If .width < MAX_COMMENT_WIDTH Then
                Exit Sub
            End If

            ' Calculate area of the comment text rectangle
            ' for a single-line comment.
            area = .width * .height

            ' Make new comment area roughly 4h x 3w.
            .width = (VBA.Sqr(area / 12)) * 3
            .height = (VBA.Sqr(area / 12)) * 4

            ' Now, for longer comments, and especially comments
            ' with line break, this leaves a lot of white space
            ' at the bottom. How do we fix it?
        End With
    End With
End Sub

Answer 1

你的代码有些错误。随着.Shape错过了。

Sub AutoSizeCommentInSelectedCell()
    Dim cellComment As Comment  ' selected cell
    Dim area As Double          ' comment rectangle area
    Dim n As Integer, vS As Variant
    Dim myMax As Integer, base As Single, rowLen As Integer
    Dim Wf As WorksheetFunction
    Dim vR(), rowCnt As Integer, myHeight As Single

    Set Wf = WorksheetFunction

    Const MAX_COMMENT_WIDTH = 300

    ' Make sure we have a seected cell.
    If ActiveCell Is Nothing Then
        Exit Sub
    End If

    ' Make sure we have a comment in the selected cell.
    Set cellComment = ActiveCell.Comment

    If cellComment Is Nothing Then
        Exit Sub
    End If

    With cellComment
        'myLen = Len(.Text)

        vS = Split(.Text, Chr(10))
        ReDim vR(UBound(vS))
        For i = 0 To UBound(vS)
            vR(i) = Len(vS(i))
        Next i
        myMax = Wf.Max(vR)
        n = UBound(vS)
        ' AutoSize will covert comment to a single line.
        .Shape.TextFrame.AutoSize = True

        ' If comment's width is shorter than max, we're done.
        With .Shape
            base = .Height / (n + 1)
            rowLen = Wf.RoundDown(myMax * (300 / .Width), 0) 'row character's length when width 300
            rowLen = rowLen - rowLen * 0.1 '<~~line character's number  is more small. 
            For i = 0 To n
                If Len(vS(i)) = 0 Then
                    rowCnt = rowCnt + 1
                Else
                    rowCnt = rowCnt + Wf.RoundUp(Len(vS(i)) / rowLen, 0)
                End If
            Next i
            myHeight = rowCnt * base

            If .Width < MAX_COMMENT_WIDTH Then
                Exit Sub
            End If
            .Width = 300
            .Height = myHeight
        End With
    End With
End Sub

如何自动调整Excel注释？

1 个答案: