在Microsoft Word中用空格替换单词

Question

我想创建一个宏，它将执行以下操作：

突出显示第n个选择。 检查选择内容以确保它是单词（而不是数字或标点符号）。 剪切单词并将其粘贴到另一个文档中。 用空格替换单词。 重复直到文档末尾。

困难的部分是检查选择内容以确认它确实是一个单词，而不是其他单词。

我发现其他人可能写了一些代码，但是我不明白如何使用其余命令在宏中实现它：

    Function IsLetter(strValue As String) As Boolean

Dim intPos As Integer
For intPos = 1 To Len(strValue)
    Select Case Asc(Mid(strValue, intPos, 1))
        Case 65 To 90, 97 To 122
            IsLetter = True
        Case Else
            IsLetter = False
            Exit For
    End Select
Next

End Function

    Sub Blank()

Dim OriginalStory As Document
Set OriginalStory = ActiveDocument
Dim WordListDoc As Document
Set WordListDoc = Application.Documents.Add

Windows(OriginalStory).Activate

sPrompt = "How many spaces would you like between each removed word?"
sTitle = "Choose Blank Interval"
sDefault = "8"
sInterval = InputBox(sPrompt, sTitle, sDefault)

Selection.HomeKey Unit:=wdStory

Do Until Selection.Bookmarks.Exists("\EndOfDoc") = True

Selection.MoveRight Unit:=wdWord, Count:=sInterval, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    If IsLetter = True Then

    Selection.Cut
    Selection.TypeText Text:="__________ "
    Windows(WordListDoc).Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows(OriginalStory).Activate

    Else

    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    Loop

Loop

End Sub

该函数应该位于其余代码的“上方”，对吗？ 但是运行它时出现错误“参数不可选”。

任何想法或技巧大加赞赏。

Answer 1

我认为以下代码可以满足您的大部分需求。 请注意，某些注释与我丢弃您的某些代码的原因有关，而其他注释可能有助于理解当前版本。

Sub InsertBlanks()
    ' 02 May 2017

    Dim Doc As Document
    Dim WordList As Document
    Dim Rng As Range
    Dim Interval As String, Inter As Integer
    Dim Wd As String

    ' you shouldn't care which Window is active,
    ' though it probably is the one you want, anyway.
    ' The important thing is which document you work on.
'    Windows(OriginalStory).Activate
    Set Doc = ActiveDocument

    Application.ScreenUpdating = False
    Set WordList = Application.Documents.Add
    ' If you want to use all these variables you should also declare them.
    ' However, except for the input itself, they are hardly necessary.
'    sPrompt = "How many spaces would you like between each removed word?"
'    sTitle = "Choose Blank Interval"
'    sDefault = "8"
    Do
        Interval = InputBox("How many retained words would you like between removed words?", _
                            "Choose Blank Interval", CStr(8))
        If Interval = "" Then Exit Sub
    Loop While Val(Interval) < 4 Or Val(Interval) > 25
    Inter = CInt(Interval)
    ' you can modify min and max. Exit by entering a blank or 'Cancel'.

    ' You don't need to select anything.
'    Selection.HomeKey Unit:=wdStory
    Set Rng = Doc.Range(1, 1)               ' that's the start of the document
'    Set Rng = Doc.Bookmarks("James").Range  ' I used another start for my testing

    Do Until Rng.Bookmarks.Exists("\EndOfDoc") = True
        Rng.Move wdWord, Inter
        Wd = Rng.Words(1)
        If Asc(Wd) < 65 Then
            Inter = 1
        Else
            Set Rng = Rng.Words(1)
            With Rng
                ' replace Len(Wd) with a fixed number of repeats,
                ' if you don't want to give a hint about the removed word.
                .Text = String(Len(Wd) - 1, "_") & " "
                .Collapse wdCollapseEnd
            End With
            With WordList.Range
                If .Words.Count > 1 Then .InsertAfter Chr(11)
                .InsertAfter Wd
            End With
            Inter = CInt(Interval)
        End If
    Loop
    Application.ScreenUpdating = True
End Sub

为了避免处理非单词，我在上面的代码中进行了粗略的测试，如果第一个字符是字母（ASCII> 64）。 这将排除数字，并允许使用许多符号。 例如，可以接受“€100”代替，但不能接受“ 100”。 您可能希望完善此测试，也许像您最初那样创建一个函数。 我想到的另一种方法是排除少于3个字符长度的“单词”。 这样可以消除CrLf（如果Word认为一个单词），但是也可以消除许多介意，而您可能不喜欢“€100”。 它要么很简单，我做的方式，要么就很复杂。

Answer 2

Variatus-非常感谢您。 它绝对完美，对我真的很有用。

您的评论对我了解一些您不熟悉的命令很有帮助。

感谢您的耐心配合和帮助。