如何自动调整Excel的评论？
我想弄清楚如何使Excel单元格中的注释popup来自动resize 。 只使用AutoSize属性是不可接受的，因为它将注释转换为单行 。 这是我的想法：
- 将
AutoSize设置为true。 - 使用单行注释的尺寸计算面积。
- 通过将单行注释区域调整为3×4纵横比（或任何纵横比看起来更好）来计算新的维度。
这种方法的问题是，对于较长的评论，特别是带有换行符的评论，这留下了底部的 空白 。
有没有办法调整评论的高度，所以没有（或至less不是太多）的空白？ 像检测评论的最后一个字母是否可见，如果不resize？ 还是用别的东西？
通过反复试验，我基本上可以根据文本的数量（或者更准确地说，单行自动评论的长度或面积）来调整评论高度，对于更短的文本评论和0.52长期（使用默认字体/等）。 但是， 换行符使得它变得更加复杂（我认为每个换行符大约有25％的文本，不包括标题换行符）。 我想让它更精确，更脆弱（如果它打破了不同的字体/等）。
如果有更好的方法？ 我打开任何想法，只要它不是一个单一的行（对于更长的评论），它不会留下很多不必要的空白，并且评论文本不会被裁剪（我不在乎文本是否裁剪到右边是Excel电子表格的边框）。
这是我的macros：
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
你的代码有一些错误。 .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
