在多个工作表vba Excel上添加评论答案

【问题标题】：AddComment on multiple sheets vba Excel在多个工作表vba Excel上添加评论
【发布时间】：2017-07-12 13:19:48
【问题描述】：

AddComment 语法适用于工作簿中的第一个选定工作表，但下一个工作表给我这个错误：错误 1004“应用程序定义或对象定义错误”。我不知道如果选择了多张工作表并且仅适用于第一个选择的工作表，为什么会崩溃。有人有什么想法吗？

 If selectedSheet.Cells(7, columnIndex).value <> 100 Then
           selectedSheet.Cells(7, columnIndex).Interior.ColorIndex = 3

           If standardReportFilePath <> "" Then 'not using the Standard Report Evalution algorithm
                        If VerifyStandardReportFile(selectedSheet.Name, selectedSheet.Cells(1, columnIndex).value, wbk, amplitude, missingCrashes) = True Then
                                selectedSheet.Cells(1, columnIndex).Interior.ColorIndex = 36 ' color the crash cell with yellow
                                Set rng = selectedSheet.Cells(1, columnIndex)
                                If rng.Comment Is Nothing Then
                                    **rng.AddComment "In Standard Report this crash starts to deploy from " & CStr(amplitude) & " amplitude"**
                                Else
                                    rng.Comment.Text "In Standard Report this crash starts to deploy from " & CStr(amplitude) & " amplitude"
                                End If
                            End If
                        End If
                    End If
                End If

显示问题的备用代码集。（在新工作簿中使用三个空白工作表运行此操作。）：

Sub test()
    Dim ws As Worksheet
    Dim Rng As Range

    'Running code with a single sheet selected
    Worksheets("Sheet1").Select

    'Code that shows issue - this will work
    Set ws = Worksheets("Sheet2")
    Set Rng = ws.Cells(1, 1)
    If Rng.Comment Is Nothing Then
        Rng.AddComment "xxx"
    End If

    'Get rid of comment again
    Rng.Comment.Delete

    'Running code with multiple sheets selected
    Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select

    'Code that shows issue - will crash on the "AddComment"
    Set ws = Worksheets("Sheet2")
    Set Rng = ws.Cells(1, 1)
    If Rng.Comment Is Nothing Then
        Rng.AddComment "xxx"
    End If

End Sub

【问题讨论】：

尝试Activate selectedSheet 每次设置一个新的。
我做到了。没有成功:(
另一个想法，也许是amplitude的问题？很抱歉没有检查这个，但我无法访问我的计算机 atm。
不，幅度很好。值存在。在弹出错误时的备忘录中，该值为-15。
@ȘtefanBlaga 我编辑了问题以包含我认为是 MCVE 的内容。希望这将使人们的注意力集中在实际问题上，而不是他们可能认为会影响事情的任何其他事情上。如果您不喜欢添加 MCVE，请随时回滚到问题的先前版本。

标签： excel comments vba

【解决方案1】：

我找到了一种解决方法，但仍然不知道为什么会出现这个问题。由于某种原因，当您选择了多个工作表时会发生错误。解决方案是...在添加带有someSheet.Select 的cmets 之前选择一张表。在宏结束时，如果需要，您可以尝试再次选择所有先前选择的工作表。

【讨论】：

我激活工作表，然后选择这样的范围： Set rng = selectedSheet.Cells(1, columnIndex) rng.Select No succes!
这不会选择工作表。试试selectedSheet.Select。
这行得通！选择整个工作表而不仅仅是范围有效

【解决方案2】：

感谢 Yoweks 的评论，我确实理解的是：您正在遍历所有选定的工作表，检查某些内容，设置 cmets（给您带来问题，因为它不适用于多个选定的工作表）并希望随后选择先前选择的工作表。

您可以将先前选择的工作表保存在一个变量中，选择其中一个，运行您的代码，然后再次选择所有先前选择的工作表。请尝试以下代码：

Sub Comments()
Dim WsArr As Sheets, WS As Worksheet, ColIdx As Long
ColIdx = 7
Set WsArr = ActiveWorkbook.Windows(1).SelectedSheets
    WsArr(1).Select
    For Each WS In WsArr
        '*** your logic
        Set Rng = WS.Cells(1, ColIdx)
        If Rng.Comment Is Nothing Then
            Rng.AddComment "In Standard Report this crash starts to deploy from " & CStr(amplitude) & " amplitude"
        Else
            Rng.Comment.Text "Changed T"
        End If
    Next WS
    WsArr.Select
End Sub

【讨论】：

【解决方案3】：

来自Excel documentation

您可以使用 cmets 向单个单元格添加注释

您可以在 Excel 的“审阅”选项卡中看到，当您选择多个工作表时，您无法创建注释。我认为这与 Excel 的内部确定应该为哪个单元格分配注释有关。

即使您选择了多张工作表，您也可以调用此函数为给定单元格分配注释。

这个 sub 还消除了测试评论是否已经存在的需要，只需将新评论传递给已经有评论的单元格。

Sub UpdateComment(Rng As Range, Cmnt As String)
    Application.ScreenUpdating = False
    ' Get currently selected sheets
    Dim mySheets As Sheets: Set mySheets = ThisWorkbook.Windows(1).SelectedSheets
    ' Set current selection to just one sheet: this is where error is avoided
    ThisWorkbook.Sheets(1).Select
    ' Set Comment, new if doesn't exist or changed if it does
    If Rng.Comment Is Nothing Then
        Rng.AddComment Cmnt
    Else
        Rng.Comment.Text Cmnt
    End If
    ' Tidy up: re-select sheets & enable screen updating
    mySheets.Select
    Application.ScreenUpdating = True
End Sub

在你的代码中像这样使用它：

' ... your previous code
Set rng = selectedSheet.Cells(1, columnIndex)
UpdateComment rng, "In standard report this crash starts to deploy from ..."

遍历所有选定的工作表

Dim sh As Worksheet
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
    Set rng = sh.Cells(1, columnIndex)
    UpdateComment rng, "In standard report this crash starts to deploy from ..."
Next sh

【讨论】：

【解决方案4】：

我在尝试让 cmets 函数工作时遇到了同样的问题，所以我决定做一个通用的，而不是试图根据场景来解决它；根据需要调用。

Sub General_Functions_Comments(InCell As Range, TxtComment As String, Optional IsMergedAnalyzed As Boolean)
Dim IsComment As Comment
Dim RangeFixedMerged As Range
    If InCell.MergeCells = False Or IsMergedAnalyzed = True Then ' 3. If InCell.MergeCells = False
    With InCell
    Set IsComment = .Comment
    If IsComment Is Nothing Then ' 1. If Iscomment Is Nothing
    .AddComment.Text Text:=TxtComment
    .Comment.Shape.TextFrame.AutoSize = True
    .Comment.Visible = False
    Else ' 1. If Iscomment Is Nothing
    If InStr(.Comment.Text, TxtComment) Then ' 2. If InStr(.Comment.Text, TxtComment)
    Else ' 2. If InStr(.Comment.Text, TxtComment)
    .Comment.Text .Comment.Text & Chr(10) & TxtComment
    .Comment.Shape.TextFrame.AutoSize = True
    .Comment.Visible = False
    End If ' 2. If InStr(.Comment.Text, TxtComment)
    End If ' 1. If Iscomment Is Nothing
    End With
    Else ' 3. If InCell.MergeCells = False
    Set RangeFixedMerged = InCell.Cells(1, 1)
    Call General_Functions_Comments(RangeFixedMerged, TxtComment, True)
    Set RangeFixedMerged = Nothing
    End If ' 3. If InCell.MergeCells = False
End Sub

在您的代码中

If standardReportFilePath <> "" Then 'not using the Standard Report Evalution algorithm
                        If VerifyStandardReportFile(selectedSheet.Name, selectedSheet.Cells(1, columnIndex).Value, wbk, amplitude, missingCrashes) = True Then
                                selectedSheet.Cells(1, columnIndex).Interior.ColorIndex = 36 ' color the crash cell with yellow
                                Set Rng = selectedSheet.Cells(1, columnIndex)
                                If Rng.Comment Is Nothing Then
                                Call General_Functions_Comments(Rng, "In Standard Report this crash starts to deploy from " & CStr(amplitude) & " amplitude", True)
                                Else: Call General_Functions_Comments(Rng, "In Standard Report this crash starts to deploy from " & CStr(amplitude) & " amplitude", True)
                                End If
                            End If
                        End If
                    End If
                End If

*抛开问题，为什么要设置 if，else 语句 if 两者都会做同样的事情？

【讨论】：

对一旁的回答：语句不做同样的事情。一个创建新评论，另一个在评论已经存在时更新它。由于这些不同的原因，OP 正在使用 .AddComment 和 .Comment.Text。
您是否尝试过所述代码？在调用之前删除评论，然后调用所需的例程

【解决方案5】：

我记得大致类似的情况（我无法从代码中做某事），努力解决它，最后我发现......

请注意，如果您选择了多张工作表，则功能区上的“新评论”按钮将处于非活动状态，因此如果您无法手动执行，则无法通过代码执行此操作。
为什么？ - 不要问我。我在上面看到了一个很好的解决方法，这似乎是实现您需要的唯一方法。

【讨论】：