求助自动添加单元格批注的VBA代码

zjdh

                                             

zjdh

以上附件没有考虑有效区域。

YZC51

学习老师的代码。谢谢老师！
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'    If Intersect(Target, Range("G3:AQ6"), Range("D10:K80"), Range("M10:BA46")) Is Nothing Then Exit Sub
    Dim TT As String
    Target.ClearNotes
    If Target.MergeCells Then
        Set R = Target(1)
    ElseIf Target.Cells.Count <> 1 Then Exit Sub
    Else
        Set R = Target
    End If
    CX R.Value
    If DAT <> "" Then
        nn = Len(Replace(DAT, Chr(10), ""))
        mm = Len(DAT) - nn + 1
        With R
            .AddComment
            Set C = .Comment
            C.Text Text:=DAT
            With C.Shape
                .Width = 220
                .Height = 13 * mm
            End With
        End With
    End If
End Sub

zjdh

nn = Len(Replace(DAT, Chr(10), ""))
mm = Len(DAT) - nn + 1这我也考虑过
但只算出了回车数量，数据不带回车的就不会全部显示了。

zjdh

这回比较完整了
自动添加批注.rar (73.91 KB, 下载次数: 7)

2020-1-17 22:10 上传

点击文件名下载附件

YZC51

学习下
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If (Intersect(Target, Range("G3:AQ6")) Is Nothing) And _
     (Intersect(Target, Range("D10:K80")) Is Nothing) And _
     (Intersect(Target, Range("M10:BA46")) Is Nothing) Then Exit Sub
     Dim TT As String
     Target.ClearNotes
     If Target.MergeCells Then
         Set R = Target(1)
     ElseIf Target.Cells.Count <> 1 Then Exit Sub
     Else
         Set R = Target
     End If
     CX R.Value
     If DAT <> "" Then
         nn = Len(Replace(DAT, Chr(10), ""))
         mm = Len(DAT) - nn '+ 1                '数据带回车的行数
         If mm < 1 Then mm = Len(DAT) / 50     '数据无回车的行数
         With R
             .AddComment
             Set C = .Comment
             C.Text Text:=DAT
             With C.Shape
                 .Width = 240
                 .Height = 13 * mm
             End With
         End With
     End If
End Sub

riversky0604

zjdh 发表于 2020-1-17 22:10
这回比较完整了

十分感谢，学习了。