您的位置:首页 > 编程语言 > VB

[VBA]批注记录修改前内容

2020-02-02 10:40 1576 查看

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo err

 Dim Str As String
 Str = "A1:D10,F:H,K:L" '限制添加批注 单元格区域
'Str = "A1:J10" '限制添加批注 单元格区域
    If Target.Rows.Count = Rows.Count Or Target.Column = Columns.Count Then Exit Sub
    If Not Intersect(Target, Range(Str)) Is Nothing Then
        Application.ScreenUpdating = False
        Dim Rag As Range, Tim As String, Arr, Brr
        Tim = Format(Now(), "yyyy年m月d日hh:mm:ss")
        For Each Rag In Intersect(Target, Range(Str))
            If Not Rag.Comment Is Nothing Then
                Arr = Split(Rag.Comment.Text, vbCrLf)
                Brr = Split(Arr(UBound(Arr)), "修改为: ")
                If Trim(Rag.Value) = Trim(Brr(UBound(Brr))) Or (Trim(Rag.Value) = "" And Trim(Brr(UBound(Brr))) = "[空白]") Then Exit Sub
                Rag.Comment.Text Rag.Comment.Text & vbCrLf & Tim & "修改为: " & IIf(Trim(Rag) = "", "[空白]", Rag)
            Else
                If Trim(Rag) <> "" Then Rag.AddComment Tim & "修改为: " & Rag
            End If

            With Rag.Comment.Shape   '美化批注
                ''判断是否已经设置过;如果已经设置过了,就不再设置
                If (.AutoShapeType = msoShapeRoundedRectangle) = False Then
                    .TextFrame.AutoSize = True                   '自适应大小
                    .AutoShapeType = msoShapeRoundedRectangle    '圆角边框
                    .Line.ForeColor.SchemeColor = 53             '边框颜色
                    .Line.Weight = 1                             '边框粗细
                    .TextFrame.Characters.Font.ColorIndex = 5    '字体颜色
                End If
            End With

            Application.ScreenUpdating = True
        Next
    End If
err:
End Sub

转载于:https://www.cnblogs.com/lxu220/p/3362041.html

  • 点赞
  • 收藏
  • 分享
  • 文章举报
design8988 发布了0 篇原创文章 · 获赞 0 · 访问量 153 私信 关注
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: