vba - 识读文档中的每个单词并将其替换为该单词的第一个字母

Question

我正在编写一个宏，通过保留这些单词之间的所有空格并保留文本的特殊字符，仅保留文档中所有单词的首字母。

代码如下

Sub rewrite_document_with_Initials()
Set myRange = ActiveDocument.Range
Dim w As String

For Each aWord In myRange.Words
w = aWord
If IsAlphabet(w) = True Then

 aWord.Select
Set A = Selection.Range
A = Left(aWord, 1)
Selection.TypeText A & " "
Else
Debug.Print aWord

 End If
 
Next aWord
End Sub
Function IsAlphabet(inpChar As String) As Boolean
    Dim chkChar As String
    
    'Convert the character to Uppercase.
    'So that there is no need to do a check for Lower and Uppercase seperately.
    chkChar = UCase(inpChar)
    
    'Check whether input character is Alphabet or not
    IsAlphabet = Asc(chkChar) > 64 And Asc(chkChar) < 91
End Function

在上面的代码中，它会忽略文档中的每个单词并检查它是否包含字母

-如果是，则将其替换为第一个字母。

但问题是，它卡在第一个单词上，不知道我是否制作了正确的范围或字符串？

如果有最短的方法，请提出建议!

Answer 1

使用正则表达式尝试此过程。它不是每个单词，而是循环每个段落，因此，它会运行得更快。

Sub rewrite_document_with_Initials()
Dim regex As Object
Dim mColl As Object

Set regex = CreateObject("VBScript.RegExp")        
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "\B[A-Za-z]+"
'I missed special characters earlier
For i = 1 To ThisDocument.Paragraphs.Count
    ThisDocument.Paragraphs(i).Range.Text = _
        regex.Replace(ThisDocument.Paragraphs(i).Range.Text, "")
Next i
End Sub