在microsoft word中用空白替换单词

Question

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

    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”的事情。它要么很简单，我做的方式，要么很复杂。