Excel,列出评论然后超链接到原始评论位置

Excel,列出评论然后超链接到原始评论位置

ListComments()我可以使用从调用的函数https://www.myonlinetraininghub.com/working-with-comments-in-vba

'
' Written by Philip Treacy
' https://www.myonlinetraininghub.com/working-with-comments-in-vba
'

Sub ListComments()

' Create a sheet called Comments (if it doesn't already exist)
' and list all comments on all other sheets in the workbook on it
'

    Dim Comment_ As Comment
    Dim CS As Worksheet
    Dim Sht As Worksheet
    Dim NextRow As Long

    ' To check for exisence of Commenst sheet, try to set an object with it
    On Error Resume Next
    Set CS = Worksheets("Comments")

    ' If the Comments sheet does not exist and error is generated
    If Err.Number <> 0 Then

        ' If we are in here then we need to create the Comments sheet
        With ActiveWorkbook

            .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Comments"

        End With

        Set CS = Worksheets("Comments")
        CS.Range("A1").Value = "Sheet"
        CS.Range("B1").Value = "Cell"
        CS.Range("C1").Value = "Author"
        CS.Range("D1").Value = "Comment"

        With CS.Range("A1:D1")

            .Font.Bold = True
            .Font.Color = vbWhite
            .Interior.Color = RGB(24, 99, 53)
            .Columns.ColumnWidth = 25

        End With

    End If

    'Reset error handling so Excel deals with it
    On Error GoTo 0

    ' Clear any list of comments that ay already exist on the Comments sheet
    CS.UsedRange.Offset(1, 0).ClearContents

    'NextRow keeps track of what row to insert the comment info to
    NextRow = 1

    For Each Sht In Worksheets

        For Each Comment_ In Sht.Comments


            CS.Range("A1").Offset(NextRow, 0) = Sht.Name
            CS.Range("A1").Offset(NextRow, 1) = Comment_.Parent.Address
            CS.Range("A1").Offset(NextRow, 2) = Comment_.Author

            'This assumes the first colon in the comment appears after the author's name
            If InStr(Comment_.Text, ":") Then

                Debug.Print Asc(Left(Mid(Comment_.Text, InStr(Comment_.Text, ":") + 1), 1))
                'Manually entered comments have a NewLine character (ASCII 10) after the :
                'The Clean function removes this
                '
                CS.Range("A1").Offset(NextRow, 3) = Application.WorksheetFunction.Clean(Mid(Comment_.Text, InStr(Comment_.Text, ":") + 1))

            Else

                CS.Range("A1").Offset(NextRow, 3) = Comment_.Text

            End If

            NextRow = NextRow + 1

        Next Comment_

    Next Sht

    Set Sht = Nothing
    Set CS = Nothing

End Sub

但是,我还需要超链接回单元格。因此,如果创建的表显示工作表名称和单元格位置,我可以使用另一列来包含指向该工作表的超链接。我尝试集成上述代码,但在 Anchor 行处收到调试错误。

答案1

插入

CS.Hyperlinks.Add CS.Range("A1").Offset(NextRow, 4), "", Sht.Name & "!" & Comment_.Parent.Address

紧接着CS.Range("A1").Offset(NextRow, 2) = Comment_.Author

此新行将超链接放置到 E 列。
每条评论旁边都添加了超链接

相关内容