晚上好,
我创建了一个 vba 宏来获取工作簿中的所有线程注释,并将它们放在名为注释的工作表中的预定义表中。除了一个部分之外,它就像一个魅力。我想为每个线程评论的单元格地址创建一个超链接。非常感谢您对此的帮助。
Sub ListCommentsThreaded()
'Application.ScreenUpdating = False
Dim myCmt As CommentThreaded
Dim curwks As Worksheet
Dim i As Long
Dim cmtCount As Long
UnprotectsingleSH
i = 1
For Each curwks In ActiveWorkbook.Worksheets
For Each myCmt In curwks.CommentsThreaded
With Sheets("Comments")
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = i - 1
.Hyperlinks.Add Anchor:=.Range(Cells(i, 2).Address), Address:="", SubAddress:="'" & curwks.Name & "'" & "!" & myCmt.parrent.Address
.Cells(i, 4).Value = myCmt.Author.Name
If myCmt.Resolved = True Then
.Cells(i, 5).Value = "Opgelost"
Else
.Cells(i, 5).Value = "Open"
End If
.Cells(i, 6).Value = myCmt.Date
.Cells(i, 7).Value = myCmt.Replies.Count
.Cells(i, 8).Value = myCmt.Text
If myCmt.Replies.Count > 0 Then
iR = 1
iRCol = 9
For iR = 1 To myCmt.Replies.Count
.Cells(1, iRCol).Value = "Antwoord " & iR
.Cells(i, iRCol).Value _
= myCmt.Replies(iR).Author.Name _
& vbCrLf _
& myCmt.Replies(iR).Date _
& vbCrLf _
& myCmt.Replies(iR).Text
iRCol = iRCol + 1
Next iR
End If
End With
Next myCmt
Next curwks
Sheets("Comments").Select
Application.ScreenUpdating = True
End Sub