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

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

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

literate through each word in the document and replace it with first letter of the word

vba

ms-word

word

alphanumeric

vba7