Excel VBA，如果新工作表中的单元格可见，则在新工作表上显示注释

标题很难完全符合我的需要，所以请阅读全文

我正在尝试使用一个按钮创建一个工作表，该工作表将以易于理解的格式向用户显示所有工作表上的所有注释，基本上作为工作簿的亮点

问题是代码当前显示所有注释，但我只希望此人看到当前可见的注释。我是什么意思？并非所有用户都可以看到所有图纸或所有列和行。某些数据是隐藏的，因为它不属于它们。我只想让他们看到任何工作表上当前可见的数据

例子不是真实情况；excel文档有三张表：表1、表2、表3。John使用Select Case VBA登录，该VBA隐藏了他不需要的数据，可以看到Sheet1和Sheet2，但无法看到每张工作表中的特定行，如Sheet1中的第2行和第F列以及Sheet2中的第5行和第K列。他不需要查看无法查看的行、列和工作表的注释

我如何修改下面的代码，使其只显示他能看到的单元格的注释

注意：我没有创建此代码，只是采用了它，因为它几乎适合我的需要

    Sub ShowCommentsAllSheets()

  Application.ScreenUpdating = False

  Dim commrange As Range
  Dim mycell As Range
  Dim ws As Worksheet
  Dim newwks As Worksheet
  Dim i As Long

Set newwks = Worksheets.Add

 newwks.Range("A1:E1").Value = _
     Array("Sheet", "Address", "Name", "Value", "Comment")

For Each ws In ActiveWorkbook.Worksheets
  On Error Resume Next
  Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
  On Error GoTo 0

  If commrange Is Nothing Then

  Else

    i = newwks.Cells(Rows.Count, 1).End(xlUp).Row

    For Each mycell In commrange
       With newwks
         i = i + 1
         On Error Resume Next
         .Cells(i, 1).Value = ws.Name
         .Cells(i, 2).Value = mycell.Address
         .Cells(i, 3).Value = mycell.Name.Name
         .Cells(i, 4).Value = mycell.Value
         .Cells(i, 5).Value = mycell.Comment.Text
       End With
    Next mycell
  End If
  Set commrange = Nothing
Next ws


newwks.Cells.WrapText = False
newwks.Columns("E:E").Replace What:=Chr(10), _
  Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, _
  SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub

我相信我需要添加以下代码来解决此问题：

   Comments = 1
   For Each MyComments In ActiveSheet.Comments
       If MyComments.Visible = True Then
           Comments = 0
       End If
   Next
   If Comments = 1 Then
       Application.DisplayCommentIndicator = xlCommentAndIndicator
   Else
       Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   End If

---

然而，我正在努力将其融入到代码中。我应该如何继续？

修改代码以覆盖可见的工作表和未隐藏的单元格

Sub ShowCommentsAllSheets()

Application.ScreenUpdating = False

Dim commrange As Range
Dim mycell As Range
Dim ws As Worksheet
Dim newwks As Worksheet
Dim i As Long

Set newwks = Worksheets.Add

newwks.Range("A1:E1").Value = _
  Array("Sheet", "Address", "Name", "Value", "Comment")

For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible = xlSheetVisible Then
        On Error Resume Next
        Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
        On Error GoTo 0
        If Not commrange Is Nothing Then
            i = newwks.Cells(Rows.Count, 1).End(xlUp).Row
         For Each mycell In commrange
            If Not (mycell.EntireRow.Hidden Or mycell.EntireColumn.Hidden) Then
                With newwks
                  i = i + 1
                  On Error Resume Next
                  .Cells(i, 1).Value = ws.Name
                  .Cells(i, 2).Value = mycell.Address
                  .Cells(i, 3).Value = mycell.Name.Name
                  .Cells(i, 4).Value = mycell.Value
                  .Cells(i, 5).Value = mycell.Comment.Text
                End With
            End If
         Next mycell
        End If
        Set commrange = Nothing
        End If
Next ws

newwks.Cells.WrapText = False
newwks.Columns("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

End Sub

---

他不需要查看无法查看的行、列和工作表的注释。如果注释位于隐藏的单元格上，则用户将无法看到注释。这是默认设置。或者我误解了你的问题？你不能在循环中添加一个If来检查工作表是否可见吗@SiddharthRout-认为他的意思是代码从用户不应该看到的工作表中收集注释。然后只需检查单元格/工作表是否隐藏：@SJRHint:检查什么是Debug.Print mycell.entirerow.hidden，Debug.Print mycell.entireclumn.hidden和Debug.Print mycell.parent.visible；我认为你应该能够管理它，但如果你尝试了一些东西，但它不起作用，你就会回来。这真的很接近我所需要的。这样可以防止隐藏图纸。但我需要将其扩展到行和列。当我尝试添加一个if语句时，就像您对行所做的那样，它不起作用。你推荐什么？我很抱歉，如果我有困难，我是自学成才的新手哦，对不起，我读错了吗，隐藏的不是表格而是行/列？实际上都是：…表格、行和列OK，上面修改的代码，让我知道你进展如何。你是学者、圣人等等。谢谢你的帮助。这正是它现在应该做的D