单元格中的拼写检查并将拼写错误的单词的颜色更改为红色

Question

我正在进行自动化，我需要拼写检查单元格中的一个段落并突出显示红色的错误单词，并且我需要在具有动态范围的列中执行此拼写检查。

我正在使用以下代码

Sub spellcheck()

    Dim intOffsetCol As Integer
    Dim intChrCnt As Integer
    Dim varTempString As Variant

    intOffsetCol = 1

        For intChrCnt = 1 To Trim(Len(ActiveCell.Value)) Step 1 'Left to right
            'A space character is represented by an ASCII code of 32.
            If Asc(Mid(ActiveCell.Value, intChrCnt, 1)) <> 32 Then
                varTempString = varTempString & Mid(ActiveCell.Value, intChrCnt, 1)
            Else


                If Not Application.CheckSpelling(Word:=varTempString) Then
                varTempString.Interior.ColorIndex = 52

                varTempString = ""
                intOffsetCol = intOffsetCol + 1
                End If
            End If
        Next intChrCnt

        If varTempString <> "" Then
            If Not Application.CheckSpelling(Word:=varTempString) Then varTempString.Interior.ColorIndex = vbRed

        End If

End Sub

我在varTempString.Interior.ColorIndex = 52上得到“运行时错误424”

为什么我在该行上收到错误？

Answer 1

varTempString被用作String变量，您的代码正在尝试更改单元格内部，这是不可能的。

突出显示特定文本的解决方案是：

Sub SpellCheckUpdate()

Dim cel As Range, CellLen As Long, CurChr As Long, TheString As String

For Each cel In Selection
    For CurChr = 1 To Len(cel.Value)
        If Asc(Mid(cel.Value, CurChr, 1)) = 32 Then
            If InStr(CurChr + 1, cel.Value, " ") = 0 Then
                TheString = Mid(cel.Value, CurChr + 1, Len(cel.Value) - CurChr)
            Else
                TheString = Mid(cel.Value, CurChr + 1, InStr(CurChr + 1, cel.Value, " ") - CurChr)
            End If
            If Not Application.CheckSpelling(Word:=TheString) Then
                cel.Characters(CurChr + 1, Len(TheString)).Font.Color = RGB(255, 0, 0)
            Else
                cel.Characters(CurChr + 1, Len(TheString)).Font.Color = RGB(0, 0, 0)
            End If
            TheString = ""
        End If
    Next CurChr
Next cel

End Sub

这是一个更简单的代码，用于突出显示带有拼写错误单词的FULL单元格：

Sub ColorMispelledCells()  
    For Each cl In ActiveSheet.UsedRange  
        If Not Application.CheckSpelling(Word:=cl.Text) Then _  
          cl.Interior.ColorIndex = 28  
    Next cl  
End Sub