Макрос Excel - разблокировка, проверка орфографии, блокировка

Question

У меня есть макрос, который должен разблокировать все листы в рабочей книге, запустить программу проверки орфографии и заблокировать все листы (с разрешенным исходным форматированием столбца / ячейки). Ошибки блокировки выявляются каждый раз, и я не могу понять, почему.

Я знаю, что это не включает аспект форматирования, но вот что у меня есть.

Sub SpellChecker()

'unprotect all sheets
For i = 1 To Sheets.Count
    Sheets(i).Unprotect "Password"
Next i

'select all sheets
Dim ws As Worksheet
For Each ws In Sheets
    If ws.Visible Then ws.Select (False)
Next

'run spellchecker
Application.CommandBars.FindControl(ID:=2).Execute

'protect sheets  
For i = 1 To Sheets.Count
    Sheets(i).Protect "Password"
Next i

'selects one sheet/deselect all
Sheets("Sheet1").Select

End Sub

Answer 1

В момент защиты листов все еще выбраны все листы.

Выберите только один до

Sheets("Sheet1").Select

'protect sheets
For I = 1 To Sheets.Count
    Sheets(I).Protect "Password"
Next I

---

Однако, возможно, делать их по одному листу за раз - идея ..?

Sub SpellChecker()

    For Each ws In Sheets
        If ws.Visible Then
            ws.Unprotect "Password"
            ws.Select
            Application.CommandBars.FindControl(ID:=2).Execute
            ws.Protect "Password"
        End If
    Next

End Sub

Answer 2

Вот метод, который не требует, чтобы рабочие листы когда-либо были незащищены - вместо этого он изменит Защиту на защищенных листах, чтобы VBA мог редактировать ячейки (но не разрешает Пользователь для их редактирования) - однако для этого требуется Range.CheckSpelling вместо Application.CommandBars.FindControl(ID:=2).Execute

Sub CheckAllSpelling()
    Dim CheckSheet As Worksheet, CheckRange As Range, CheckCell As Range, SheetVisible AS XlSheetVisibility
    'Loop through Worksheets in the Workbook
    For Each CheckSheet In ThisWorkbook.Worksheets
        'Allow VBA to edit a Protected Sheet, but not the User
        If CheckSheet.ProtectContents Then CheckSheet.Protect Password:="Password", UserInterfaceOnly:=True
        'Filter for Cells with Text to check
        On Error Resume Next
        Set CheckRange = CheckSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
        On Error GoTo 0
        'If there are Cells to Check
        If Not CheckRange Is Nothing Then
            SheetVisible = CheckSheet.Visible
            'Loop through cells
            For Each CheckCell In CheckRange.Cells
                With CheckCell
                    'If there is a typo, show the cell and Spellcheck it
                    If Not Application.CheckSpelling(.Text) Then
                        CheckSheet.Visible= xlSheetVisible
                        CheckSheet.Activate
                        .Select
                        .Show
                        DoEvents
                        'This next line is to fix a bug when checking a single cell
                        CheckSheet.Range(.MergeArea.Address & ", " & .MergeArea.Address) _
                        .CheckSpelling
                    End If
                End With
            Next CheckCell
            CheckSheet.Visible= SheetVisible
        End If
        'Tidy up the Loop
        Set CheckRange = Nothing
    Next CheckSheet
    'Same message as normal Spellcheck
    MsgBox "Spell check complete.  You're good to go!", vbExclamation
End Sub

(обратите внимание на исправление ошибки, при которой проверка одной ячейки вместо этого проверяет весь лист)