调整excel注释大小以适合具有特定宽度

时间:2017-08-04 21:30:29

标签: excel vba excel-vba comments

我希望评论框恰好适合评论(底部没有额外的空格)。

我知道有.AutoSize,但我希望最大宽度为300。

这是我的代码,

For Each mycell In myRng.Cells
    If Not (mycell.Comment Is Nothing) Then
      With mycell.Comment.Shape
        .TextFrame.AutoSize = True
        If .width > 300 Then
          lArea = .width * .height
          .width = 300
          .height = (lArea / 300)
        End If
      End With
    End If
Next mycell

mycellmyRng是Range数据类型,lArea是Long。

现在,它的效果相对较好,但在多个注释的底部留下了额外的空间,因为AutoSized文本占用的区域与AutoSized注释框的区域不同。

有没有办法检查评论中的空白区域然后修剪它?或者是我最好的东西是什么?

3 个答案:

答案 0 :(得分:4)

试试这个...测试评论已经放在单元格E4中

通过将Range("e4").Comment.Shape.TextFrame放入Watch窗口

来发现

Sub testComment()

    With Range("e4").Comment.Shape

        .TextFrame.AutoSize = True

        lArea = .Width * .Height

        .Width = 300
        .Height = (lArea / .Width)       ' used .width so that it is less work to change final width

        .TextFrame.AutoMargins = False
        .TextFrame.MarginBottom = 0      ' margins need to be tweaked
        .TextFrame.MarginTop = 0
        .TextFrame.MarginLeft = 0
        .TextFrame.MarginRight = 0
    End With
End Sub

答案 1 :(得分:0)

有一个autosize功能。

这是一个显示如何使用的小代码:

Dim Rg_Com as Range , Rg_Value as Range
Set Rg_Com = Cells(1,1)
Set Rg_Value = Cells(1,2)

'Comment in A1 will be same as Text in B1:
With Rg_Com
    .ClearComments
    .AddComment
    With .Comment
        .Text Text:=Rg_Value.Value2
        .Shape.TextFrame.AutoSize = True  '<<< just to make all text visible in one comment, all chars having the basic size
    End With
End With

答案 2 :(得分:0)

我已更改了前一条注释中的代码,仅在宽度大于300时才调整盒子的大小,因为否则,小盒子的最终大小会弄乱。还更改为通过活动表上的所有注释框

Sub reset_box_size()
Dim pComment As Comment
For Each pComment In Application.ActiveSheet.Comments
    With pComment.Shape

        .TextFrame.AutoSize = True

        lArea = .Width * .Height
        
        'only resize the autosize if width is above 300
        If .Width > 300 Then .Height = (lArea / .Width)       ' used .width so that it is less work to change final width

        
        .TextFrame.AutoMargins = False
        .TextFrame.MarginBottom = 0      ' margins need to be tweaked
        .TextFrame.MarginTop = 0
        .TextFrame.MarginLeft = 0
        .TextFrame.MarginRight = 0
        End With
Next

End Sub