[VBA]批注记录修改前内容
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
- 点赞
- 收藏
- 分享
- 文章举报
- [VBA]批注记录修改前内容
- OFFICE 修改记录保存在单元格批注中vba
- git--02忽略文件、查看修改内容、撤销未提交的修改、查看提交记录
- 在开发修改了分支内容之后但是在历史中没有看到开发的提交记录
- springboot详细记录业务修改内容,包含修改前后具体字段的值的具体变化
- 软件测试典型问题记录-修改窗口页面存在两个页签,修改后在某个页签点确定,另一页签内容未修改
- VBA实现批量修改Word文档的页脚内容
- java 记录对象前后修改的内容(工具类)
- 添加用户操作历史记录时,纪录用户修改内容用反射技术实现
- Python 逐行修改txt每条记录的内容
- Android APK系列5-------修改APK中的内容
- UIWebview 截获html并修改内容。
- 页面上有个添加按钮,程序运行成功的,当我添加一条记录后刷新页面,它自动又添加一条,这样怎么修改?
- Launcher修改记录
- dedecms如何修改共0页/0条记录为英文版?
- iOS 修改导航栏的返回按钮的内容
- DedeCms V5.3“栏目内容”无法保存和修改的问题解决方法
- db2取前十条记录 db2修改字段长度 db2增加字段方法
- 错误 frm-40654 记录已经被另一个用户更新,重新查询以查看修改
- table动态修改表格内容