0

我对 Visual Basic for Applications 非常陌生，所以这个问题让我有点困惑。我想创建一个代码，它可以扫描 word 文档并将字母的颜色更改为分配给该特定字母的特定颜色，贯穿整个文档。例如，字母“A”和“a”将是深蓝色，而字母“B”和“b”将是深绿色。该代码有效，但是需要很长时间。我不知道代码是否可以改进得更快，因为我对此很陌生。我使用仅更改一个字母颜色的代码示例创建了此代码，我在这里找到了该代码（https://superuser.com/questions/230665/how-do-i-change-the-font-color-of- a-specific-letter-throughout-the-entire-ms-wor）。我创建的代码如下：

Sub ChangeLetterColor()

Const LETTERA = "A"
Const ALETTER = "a"
Const LETTERB = "B"
Const BLETTER = "b"
Const LETTERC = "C"
Const CLETTER = "c"
Const LETTERD = "D"
Const DLETTER = "d"
Const LETTERE = "E"
Const ELETTER = "e"
Const éLETTER = "é"
Const èLETTER = "è"
Const LETTERF = "F"
Const FLETTER = "f"
Const LETTERG = "G"
Const GLETTER = "g"
Const LETTERH = "H"
Const HLETTER = "h"
Const LETTERI = "I"
Const ILETTER = "i"
Const LETTERJ = "J"
Const JLETTER = "j"
Const LETTERK = "K"
Const KLETTER = "k"
Const LETTERL = "L"
Const LLETTER = "l"
Const LETTERM = "M"
Const MLETTER = "m"
Const LETTERN = "N"
Const NLETTER = "n"
Const LETTERO = "O"
Const OLETTER = "o"
Const òLETTER = "ò"
Const LETTERP = "P"
Const PLETTER = "p"
Const LETTERQ = "Q"
Const QLETTER = "q"
Const LETTERR = "R"
Const RLETTER = "r"
Const LETTERS = "S"
Const SLETTER = "s"
Const LETTERT = "T"
Const TLETTER = "t"
Const LETTERU = "U"
Const ULETTER = "u"
Const LETTERV = "V"
Const VLETTER = "v"
Const LETTERW = "W"
Const WLETTER = "w"
Const LETTERX = "X"
Const XLETTER = "x"
Const LETTERY = "Y"
Const YLETTER = "y"
Const LETTERZ = "Z"
Const ZLETTER = "z"

For i = 1 To ThisDocument.Range.Characters.Count
If ThisDocument.Range.Characters(i) = LETTERA Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkBlue
End If
If ThisDocument.Range.Characters(i) = ALETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkBlue
End If
If ThisDocument.Range.Characters(i) = LETTERB Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = BLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = LETTERC Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTurquoise
End If
If ThisDocument.Range.Characters(i) = CLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTurquoise
End If
If ThisDocument.Range.Characters(i) = LETTERD Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray25
End If
If ThisDocument.Range.Characters(i) = DLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray25
End If
If ThisDocument.Range.Characters(i) = LETTERE Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTeal
End If
If ThisDocument.Range.Characters(i) = ELETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTeal
End If
If ThisDocument.Range.Characters(i) = éLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTeal
End If
If ThisDocument.Range.Characters(i) = èLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTeal
End If
If ThisDocument.Range.Characters(i) = LETTERF Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkYellow
End If
If ThisDocument.Range.Characters(i) = FLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkYellow
End If
If ThisDocument.Range.Characters(i) = LETTERG Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdRed
End If
If ThisDocument.Range.Characters(i) = GLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdRed
End If
If ThisDocument.Range.Characters(i) = LETTERH Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdViolet
End If
If ThisDocument.Range.Characters(i) = HLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdViolet
End If
If ThisDocument.Range.Characters(i) = LETTERI Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBrightGreen
End If
If ThisDocument.Range.Characters(i) = ILETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBrightGreen
End If
If ThisDocument.Range.Characters(i) = LETTERJ Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkRed
End If
If ThisDocument.Range.Characters(i) = JLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkRed
End If
If ThisDocument.Range.Characters(i) = LETTERK Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkYellow
End If
If ThisDocument.Range.Characters(i) = KLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkYellow
End If
If ThisDocument.Range.Characters(i) = LETTERL Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = LLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = LETTERM Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdPink
End If
If ThisDocument.Range.Characters(i) = MLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdPink
End If
If ThisDocument.Range.Characters(i) = LETTERN Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray50
End If
If ThisDocument.Range.Characters(i) = NLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray50
End If
If ThisDocument.Range.Characters(i) = LETTERO Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdYellow
End If
If ThisDocument.Range.Characters(i) = OLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdYellow
End If
If ThisDocument.Range.Characters(i) = òLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdYellow
End If
If ThisDocument.Range.Characters(i) = LETTERP Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBlack
End If
If ThisDocument.Range.Characters(i) = PLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBlack
End If
If ThisDocument.Range.Characters(i) = LETTERR Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdViolet
End If
If ThisDocument.Range.Characters(i) = RLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdViolet
End If
If ThisDocument.Range.Characters(i) = LETTERS Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdRed
End If
If ThisDocument.Range.Characters(i) = SLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdRed
End If
If ThisDocument.Range.Characters(i) = LETTERT Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkBlue
End If
If ThisDocument.Range.Characters(i) = TLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkBlue
End If
If ThisDocument.Range.Characters(i) = LETTERU Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTurquoise
End If
If ThisDocument.Range.Characters(i) = ULETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdTurquoise
End If
If ThisDocument.Range.Characters(i) = LETTERV Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray25
End If
If ThisDocument.Range.Characters(i) = VLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGray25
End If
If ThisDocument.Range.Characters(i) = LETTERW Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdPink
End If
If ThisDocument.Range.Characters(i) = WLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdPink
End If
If ThisDocument.Range.Characters(i) = LETTERX Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdYellow
End If
If ThisDocument.Range.Characters(i) = XLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdYellow
End If
If ThisDocument.Range.Characters(i) = LETTERY Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = YLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdGreen
End If
If ThisDocument.Range.Characters(i) = LETTERZ Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBlack
End If
If ThisDocument.Range.Characters(i) = ZLETTER Then
ThisDocument.Range.Characters(i).Font.ColorIndex = wdBlack
End If

Next

End Sub

如果这很糟糕，我很抱歉，但我只是一个初学者，如果有人可以帮助我，将不胜感激。当我在启用宏的 word 文档中运行此代码时，仅写一页就需要一个多小时，我已经在多台计算机上尝试过。

4

2 回答 2

2

使用 VBA 的对象模型可能会更快，但至少我会尝试这个。

由于一旦找到所需的字符就不需要在每次迭代中检查其他字符，因此该if语句序列的效率非常低。我将首先使用elseif语句并按可能的频率对字符进行排序（首先是元音，依此类推，具体取决于您的语言）。

您可能还想缓存字符，这可能会提高速度。

所以像：

Dim ch as String
For i = 1 To ThisDocument.Range.Characters.Count
    Ch = ThisDocument.Range.Characters(i)

    If Ch = LETTERE or Ch = ELETTER Then
        ThisDocument.Range.Characters(i).Font.ColorIndex = wdTeal
    ElseIf Ch = LETTERA Or Ch = ALETTER Then
        ThisDocument.Range.Characters(i).Font.ColorIndex = wdDarkBlue
    ElseIf ...
    End If
Next

您还可以考虑将所有字母转换为大写版本的可能性：

    Ch = UCase (ThisDocument.Range.Characters(i))

这样每个单独的If/ElseIf部分都可以简化为一张支票。

于 2013-06-06T12:36:54.983 回答
1

我并不奇怪ThisDocument.Range.Characters(i)是慢。确实应该如此。

尝试这个：

Private Type ColorForLetter
  Letter As String
  ColorIndex As WdColorIndex
End Type


Public Sub ColorAllLetters(ByVal r As Range, ColorData() As ColorForLetter, ByVal MatchCase As Boolean)
  Dim i As Long

  For i = LBound(ColorData) To UBound(ColorData)
    With r.Find
      .ClearFormatting
      .ClearAllFuzzyOptions

      With .Replacement
        .ClearFormatting
        .Font.ColorIndex = ColorData(i).ColorIndex
      End With

      .Execute FindText:=ColorData(i).Letter, MatchCase:=MatchCase, Replace:=wdReplaceAll
    End With
  Next
End Sub


Public Sub Test()
  Dim info(1 To 29) As ColorForLetter

  With info(1)
    .Letter = "A"
    .ColorIndex = wdDarkBlue
  End With

  With info(2)
    .Letter = "B"
    .ColorIndex = wdGreen
  End With

  'Following lines are inlined for brevity, but they do same as above

  With info(3): .Letter = "C": .ColorIndex = wdTurquoise: End With
  With info(4): .Letter = "D": .ColorIndex = wdGray25: End With

  With info(5): .Letter = "E": .ColorIndex = wdTeal: End With
  With info(6): .Letter = ChrW$(&HC9&): .ColorIndex = wdTeal: End With 'My locale does not support this letter as a literal
  With info(7): .Letter = ChrW$(&HC8&): .ColorIndex = wdTeal: End With 'My locale does not support this letter as a literal
  With info(8): .Letter = "F": .ColorIndex = wdDarkYellow: End With
  With info(9): .Letter = "G": .ColorIndex = wdRed: End With
  With info(10): .Letter = "H": .ColorIndex = wdViolet: End With
  With info(11): .Letter = "I": .ColorIndex = wdBrightGreen: End With
  With info(12): .Letter = "J": .ColorIndex = wdDarkRed: End With
  With info(13): .Letter = "K": .ColorIndex = wdDarkYellow: End With
  With info(14): .Letter = "L": .ColorIndex = wdGreen: End With
  With info(15): .Letter = "M": .ColorIndex = wdPink: End With
  With info(16): .Letter = "N": .ColorIndex = wdGray50: End With
  With info(17): .Letter = "O": .ColorIndex = wdYellow: End With
  With info(18): .Letter = ChrW$(&HD3&): .ColorIndex = wdYellow: End With
  With info(19): .Letter = "P": .ColorIndex = wdBlack: End With
  With info(20): .Letter = "Q": .ColorIndex = wdGray25: End With  'You don't have instructions for this one
  With info(21): .Letter = "R": .ColorIndex = wdViolet: End With
  With info(22): .Letter = "S": .ColorIndex = wdRed: End With
  With info(23): .Letter = "T": .ColorIndex = wdDarkBlue: End With
  With info(24): .Letter = "U": .ColorIndex = wdTurquoise: End With
  With info(25): .Letter = "V": .ColorIndex = wdGray25: End With
  With info(26): .Letter = "W": .ColorIndex = wdPink: End With
  With info(27): .Letter = "X": .ColorIndex = wdYellow: End With
  With info(28): .Letter = "Y": .ColorIndex = wdGreen: End With
  With info(29): .Letter = "Z": .ColorIndex = wdBlack: End With


  Application.ScreenUpdating = False

  ColorAllLetters ThisDocument.Range, info, False

  Application.ScreenUpdating = True
End Sub

65 页的完整文本大约需要 80 秒。

于 2013-06-06T13:00:09.817 回答