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

该功能应该高于＆＃39;其余的代码对吗？但我得到一个错误的参数不是可选的＆＃39;我跑的时候。

非常感谢任何想法或提示。

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 - 非常感谢你。它非常完美，对我来说非常有用。

您的评论有助于我了解您使用的一些我不熟悉的命令。

我非常感谢你的耐心和帮助。

在微软的单词中用空格替换单词

2 个答案: