Question

我找到了许多用于创建的示例，但没有用于检索单元格注释的文本。我错过了一些明显的东西吗？

Answer 1

Range.Comment.Text似乎没有任何问题......

（例如if not ActiveCell.Comment is nothing then debug.print ActiveCell.Comment.Text）

Answer 2

尝试去：

Dim comtext as string

If ActiveCell.Comment Is Nothing Then
        comtext = ""
        Else
        comtext = ActiveCell.Comment.Text
        End If

对于我来说，如果要将注释文本粘贴为其他单元格值，则可能需要使用：

Selection.ClearFormats

因为有时注释您粘贴或设置的单元格值的文本最初可能不可见。

PS。这是我在这方面的第一篇文章，所以我才刚刚开始学习绳索。

Answer 3

        Option Explicit


Sub ExtractComments()
Dim ExComment As Comment
Dim OneCommentThreaded As CommentThreaded
Dim OneReply As Excel.CommentThreaded
Dim i As Integer
Dim ws As Worksheet
Dim CurrentSheet As Worksheet

For Each ws In Worksheets
  If ws.Name = "Comments" Then
  i = 1
  ws.Columns("A:X").EntireColumn.Delete
  End If
Next ws
    
If i = 0 Then
  Set ws = Worksheets.Add(After:=ActiveSheet)
  ws.Name = "Comments"
Else: Set ws = Worksheets("Comments")
End If
ws.Range("A1").Value = ActiveWorkbook.Name
'Set headings
  ws.Range("A2").Value = "Lp"
  ws.Range("B2").Value = "Sheet"
  ws.Range("C2").Value = "Cell"
  ws.Range("D2").Value = "Commented text"
  ws.Range("E2").Value = "Comment"
  ws.Range("F2").Value = "Author"
  ws.Range("G2").Value = "Date"
  ws.Range("H2").Value = "Type of comment"
  With ws.Range("A2:H2")
    .Font.Bold = True
    .Interior.Color = RGB(189, 215, 238)
    .Columns("B").ColumnWidth = 30
    .Columns("D:F").ColumnWidth = 30
    .Columns("G").ColumnWidth = 15
    .Columns("H").ColumnWidth = 30
  End With

  With ws.Range("A1:B1").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
'Retrieve old comments
For Each CurrentSheet In Worksheets
    'loop for old style comments
    For Each ExComment In CurrentSheet.Comments
     ws.Range("A1").End(xlDown).Offset(1, 0) = ws.Range("A1").End(xlDown).Row - 1
     ws.Range("A1").End(xlDown).Offset(0, 1) = CurrentSheet.Name
     ws.Range("A1").End(xlDown).Offset(0, 2) = ExComment.Parent.Address
     ws.Range("A1").End(xlDown).Offset(0, 3) = ExComment.Parent.Value
     ws.Range("A1").End(xlDown).Offset(0, 4) = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
     ws.Range("A1").End(xlDown).Offset(0, 5) = ExComment.Author
     ws.Range("A1").End(xlDown).Offset(0, 7) = "Note"
   
    Next ExComment
    'loop for new style threaded comments
     For Each OneCommentThreaded In CurrentSheet.CommentsThreaded
        
      ws.Range("A1").End(xlDown).Offset(1, 0) = ws.Range("A1").End(xlDown).Row - 1
      ws.Range("A1").End(xlDown).Offset(0, 1) = CurrentSheet.Name
      ws.Range("A1").End(xlDown).Offset(0, 2) = OneCommentThreaded.Parent.Address
      ws.Range("A1").End(xlDown).Offset(0, 3) = OneCommentThreaded.Parent.Value
      ws.Range("A1").End(xlDown).Offset(0, 4) = OneCommentThreaded.Text
      ws.Range("A1").End(xlDown).Offset(0, 5) = OneCommentThreaded.Author.Name
      ws.Range("A1").End(xlDown).Offset(0, 6) = Format(OneCommentThreaded.Date, "dd/MM/yyyy")
      ws.Range("A1").End(xlDown).Offset(0, 7) = "Threaded comment"
  
              For Each OneReply In OneCommentThreaded.Replies
                With OneReply
      ws.Range("A1").End(xlDown).Offset(1, 0) = ws.Range("A1").End(xlDown).Row - 1
      ws.Range("A1").End(xlDown).Offset(0, 1) = CurrentSheet.Name
      ws.Range("A1").End(xlDown).Offset(0, 2) = OneReply.Parent.Parent.Address
      ws.Range("A1").End(xlDown).Offset(0, 3) = OneReply.Parent.Parent.Value
      ws.Range("A1").End(xlDown).Offset(0, 4) = OneReply.Text
      ws.Range("A1").End(xlDown).Offset(0, 5) = OneReply.Author.Name
      ws.Range("A1").End(xlDown).Offset(0, 6) = Format(OneReply.Date, "dd/MM/yyyy")
      ws.Range("A1").End(xlDown).Offset(0, 7) = "REPLY ON Threaded comment"
                              
                End With
            Next OneReply
       
    Next OneCommentThreaded
Next CurrentSheet

  ws.Range("A2:H100000").WrapText = False
  ws.Range("A2:H2").AutoFilter
End Sub

如何检索单元格注释的文本

3 个答案: