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

（请注意该错误的修复程序，其中检查单个单元格将改为检查整个工作表）