AddComment auf mehreren Blättern vba Excel

Question

Die AddComment-Syntax funktioniert auf dem ersten ausgewählten Blatt in der Arbeitsmappe, aber für die nächste gibt mir diesen Fehler: Fehler 1004 "anwendungsdefinierte oder objektdefinierte Fehler". Ich weiß nicht, warum abstürzt, wenn mehrere Blätter ausgewählt wurden und nur für das erste ausgewählte funktioniert. Hat jemand eine Idee?

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 

Ein alternativer Code, der das Problem anzeigt. (Führen Sie dies mit drei leeren Arbeitsblatt in einer neuen Arbeitsmappe.):

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 

Answer 1

ich eine Abhilfe gefunden, aber immer noch nicht wissen, warum dieses Problem geschieht auch. Aus irgendeinem Grund tritt ein Fehler auf, wenn Sie mehr als ein Arbeitsblatt ausgewählt haben. Die Lösung ist ... So wählen Sie ein Blatt aus, bevor Sie Kommentare mit someSheet.Select hinzufügen. Am Ende des Makros können Sie versuchen, alle zuvor ausgewählten Blätter bei Bedarf erneut auszuwählen.

Answer 2

Ich hatte das gleiche Problem beim Versuch, eine Kommentarfunktion zu bekommen, so dass ich, anstatt es pro Szenario herauszufinden, beschloss, ein allgemeines zu machen; Anruf bei Bedarf.

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 

In Ihrem Code

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 

* Abgesehen Frage, warum, setzt ein, wenn else-Anweisung, wenn beide das gleiche tun?

Answer 3

Was ich verstehe - dank Yoweks Kommentar - ist: Sie durchlaufen alle ausgewählten Blätter, überprüfen Sie etwas, setzen Sie Kommentare (geben Sie die Probleme, weil es nicht mit mehr als einem ausgewählten Blatt funktioniert) und möchten, dass die zuvor ausgewählten Blätter anschließend ausgewählt werden.

Sie können das zuvor ausgewählte Blatt in einer Variablen speichern, eines davon auswählen, Ihren Code ausführen und dann alle vorher ausgewählten Blätter erneut auswählen. Bitte versuchen Sie den folgenden Code:

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 

Answer 4

Ich erinnere mich, im Allgemeinen ähnlich gelagerten Fall (ich etwas von Code tun könnte), hart versucht, es zu lösen, und schließlich fand ich, dass ...

Beachten Sie, dass, wenn Sie Mehrere Blätter ausgewählt, Schaltfläche "Neuer Kommentar" auf der Multifunktionsleiste ist inaktiv, so dass Sie es nicht aus Code tun können, wenn Sie es manuell nicht tun können.
Warum? - Frag mich nicht. Ich sehe oben einen schönen Workaround, der die einzige Möglichkeit zu erreichen scheint, was Sie brauchen.

Answer 5

Vom Excel documentation

You can add notes to individual cells by using comments

Sie in den ‚Überprüfung‘ Registerkarte in Excel sehen, dass, wenn Sie mehrere Blätter auswählen, können Sie keinen Kommentar erstellen. Ich gehe davon aus, dass dies mit den Interna von Excel zu tun hat, die bestimmen, welcher Zelle ein Kommentar zugewiesen werden soll.

Hier ist eine Funktion, die Sie aufrufen können, um einer bestimmten Zelle einen Kommentar zuzuweisen, selbst wenn Sie mehrere Blätter ausgewählt haben.

Dieses Sub entfernt auch die Notwendigkeit zu testen, ob ein Kommentar bereits existiert, übergeben Sie einfach einen neuen Kommentar zu einer Zelle, die bereits eine hat.

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 

---

es wie Verwenden so im Code:

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

Um Schleife über alle ausgewählten Blätter

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