Как удалить все строки с определенным Shading.BackgroundPatternColor (из выбранной таблицы)

Question

Я хочу связать горячую клавишу с макросом VBA, который я могу использовать в некоторых таблицах моего документа Word.Этот макрос должен пройти по всем строкам выбранной таблицы и удалить те, которые имеют определенный Shading.BackgroundPatternColor

. Я пробовал следующий код:

Sub DeleteRowWithShading()


Dim oRow As Word.Row

  For Each oRow In Selection.Rows
        If oRow.Shading.BackgroundPatternColor = -721354855 Then
            oRow.Delete
        End If
  Next oRow

End Sub

Цикл по всем строкамтаблица верна, но строки не удаляются, как ожидалось.

Я довольно новичок в VBA, поэтому любая помощь приветствуется!

Answer 1

Проблемы возникают, когда элементы коллекции удаляются во время цикла. Удаление удаляет элемент из коллекции, что приводит к внутреннему отсчету.

Есть два основных способа обойти это.

1) Прорабатывайте предметы от начала до конца. Поскольку то, что удаляется из коллекции, было в конце, отсчет не сбрасывается:

Sub DeleteRowWithShading()
    Dim oRow As Word.Row
    Dim tbl As Word.Table
    Dim nrRows As Long, rowCounter As Long
    Dim check As Long

    Set tbl = Selection.Tables(1)
    nrRows = tbl.Rows.Count

  For rowCounter = nrRows To 1 Step -1
        Set oRow = tbl.Rows(rowCounter)
        If oRow.Shading.BackgroundPatternColor = -721354855 Then
            check = check + 1
            oRow.Delete
        End If
  Next
  Debug.Print "Nr of rows deleted: " & check

End Sub

2) Добавьте элементы в массив или пользовательскую коллекцию во время первого цикла, затем зациклите массив / коллекцию, чтобы удалить все элементы (строки).

Sub DeleteRowWithShadingInArray()
    Dim oRow As Word.Row
    Dim tbl As Word.Table
    Dim RowsToDelete() As Variant
    Dim check As Long, itemNr As Long

    Set tbl = Selection.Tables(1)
    itemNr = 0
    For Each oRow In tbl.Rows
        ReDim Preserve RowsToDelete(itemNr)
        If oRow.Shading.BackgroundPatternColor = -721354855 Then
            Set RowsToDelete(itemNr) = oRow
            itemNr = itemNr + 1
        End If
    Next

    itemNr = 0

    For itemNr = 0 To UBound(RowsToDelete)
            check = check + 1
            RowsToDelete(itemNr).Delete
    Next

    Debug.Print "Nr of rows deleted: " & check

End Sub