0

晚上好,

我创建了一个 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
4

0 回答 0