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

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