VBA 批量调整 EXCEL 批注默认位置

2025-11-20 07:13:45

1、Sub 恢复批注到默认位置()’’’’删除原批注然后重建，彻底解决编辑批注时位置定位很远的乱象

‘’’’’’解决Excel批注变成一条线的混乱情况

Dim Cmt As Comment, cmtText As String, PCrow As Integer, PCcol As Integer

For Each Cmt In ActiveSheet.Comments '''1.查找批注

With Cmt

cmtText = .Text '''2.1 读取批注内容

PCrow = .Parent.Row '''2.2 确定批注单元格行、列

PCcol = .Parent.Column

.Delete '''3.删除批注

End With

Cells(PCrow, PCcol).AddComment '''4.重建批注

With Cells(PCrow, PCcol).Comment '''5.调整批注文本宽大小

.Visible = False

.Text Text:=cmtText '''5.1 恢复批注内容

.Shape.TextFrame.AutoSize = True '''5.2 批注自动尺寸

If .Shape.Width > 150 Then '''5.3 设置批注宽度大于150时的尺寸

.Shape.Height = (.Shape.Height * .Shape.Width / 140) * 1.2

.Shape.Width = 150

Else '''5.4 设置批注宽度小于150时的尺寸

.Shape.Height = .Shape.Height * 1.2

If .Shape.Width < 80 Then

.Shape.Width = 80

Else

.Shape.Width = 150

End If

End With

End Sub

Sub 设置批注格式SetCommentPlacement() '设置选中单元格的批注属性位置随单元格而变化

Dim cell As Range

    Dim yWidth As Long

    For Each cell In Selection
        If Not cell.Comment Is Nothing Then
            cell.Comment.Shape.TextFrame.AutoSize = True
            cell.Comment.Shape.Placement = xlMove
            With cell.Comment.Shape
                .TextFrame.AutoSize = True
                 If .Width > 250 Then
                    yWidth = .Width * .Height
                    .Width = 150
                    .Height = (yWidth / 200) * 1.8
                 End If
                .Height = .Height + 20
            End With
       End If
    Next cell
End Sub

2、在要恢复的Excel表中运行宏

声明：本网站引用、摘录或转载内容仅供网站访问者交流或参考，不代表本站立场，如存在版权或非法内容，请联系站长删除，联系邮箱：site.kefu@qq.com。