设置批注的属性---位置、边框、高度、颜色等

设置批注的属性---位置、边框、高度、颜色等  [复制链接]

nbchn TA的精华主题 TA的得分主题

这个测试了半天，可能只能用VBA才能解决，执行如下宏，即可批量将表中的全部批注填充色设置为透明的， Sub test() Dim Com As Range For Each Com In Sheet1.UsedRange.SpecialCells(xlCellTypeComments) Com.Comment.Visible = True Com.Comment.Shape.Select True Selection.ShapeRange.Fill.Visible = msoFalse Com.Comment.Visible = False Next End Sub     近期工作中经常使用到批注，可是批注的位置却不是很理想，如果批注很多要改动就很麻烦，就想用VBA实现批注位置自动放到指定位置，在论坛中找了几天，在其他代码的基础上必了一下，为了方便像我这样的新人使用，特注释了放上来大家公享。本贴所有代码都是在论坛里找的，已忘记出处，敬请谅解。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' 鼠标单击事件     Application.ScreenUpdating = False   '关闭屏幕刷新     On Error Resume Next                  '忽略错误     Application.EnableEvents = False '先禁止触发事件     Application.Calculation = xlCalculationManual    '手动重算     Dim lngRow As Long, LngColumn   As Long, xx As Range ,  Lk  As Range , lArea As Long  ‘定义类型     LngColumn = Target.Column      '获取当前单元格的列号     lngRow = Target.Row                  '获取当前单元格 的行号         For Each xx In Cells(lngRow, LngColumn) '只修改当前选中单元格的批注属性   'ActiveSheet.Cells.SpecialCells(xlCellTypeComments)   ’修改所有批注属性                 xx.Comment.Visible = False               '   / True '如果希望备注显示，留True，不显示，留False                Lk = xx.ColumnWidth                      '设置Lk等于单元格列宽                With xx.Comment.Shape                         .Left = xx.Offset(0, 3).Left        '设置批注左右位置，Offset(0, 3) 中后一个数是正数时显示在右边，负数时显示在左边，3表示批注显示在本单元格右边第3列，                         .Top = xx.Offset(-1, 0).Top      '设置批注上下位置， Offset(0, 3) 中后一个数是正数时显示在下边，负数时显示在上边，3表示批注显示在本单元格右边第3行，                         .TextFrame.AutoSize = True      '自动适应内容                                                      lArea = .Width * .Height                                    .Width = Lk * 6.1                      ‘定义批注宽度等于单元格列宽                         .Height= (lArea / .Width * 6.1) * 0.3                               ' ‘定义批注高度                         .AutoShapeType = msoShapeRoundedRectangle       '圆角边框                         .Line.ForeColor.SchemeColor = 53                              '边框颜色                         .Line.Weight = 1                                                         '边框粗细                         .TextFrame.Characters.Font.ColorIndex = 5               '字体颜色                  End With           Next xx     Application.Calculation = xlCalculationAutomatic    '自动重算     Application.EnableEvents = True                      '恢复触发事件     On Error GoTo 0                                      '恢复正常的错误提示     Application.ScreenUpdating = True                    '开启屏幕刷新                                  End Sub