Макрос слова для замены слов через определенные интервалы пробелом

Question

Я действительно новичок в макросах в Word, но я хочу автоматизировать процесс, и я хочу узнать, может ли кто-нибудь мне помочь.

Я учитель языка. Я хочу взять историю, которую создал мой класс, выбрать каждое 8-е (или n-е) слово и вырезать его из документа. Затем я хочу заменить извлеченное слово на «пустое» (т. Е. 8 подчеркиваний, на которых студент напишет), а затем вставить извлеченное слово в другое место.

Я возился с этим и придумал следующее:

Sub Blankify8()

 Blankify8 Macro


    Selection.MoveRight Unit:=wdWord, Count:=8
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.TypeText Text:="____________ "
    Windows("Document4").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows("Document3").Activate
End Sub

Есть несколько проблем с этим. Во-первых, я бы предпочел, чтобы слова были вставлены в текстовое поле или таблицу в том же документе, а не вставлены в другой документ вообще. Я не мог понять, как это сделать. Конечно, если во время работы макроса не будет открыт «документ 4», он тоже не будет работать.

Вторая проблема заключается в том, что, удерживая управление и пропуская 8 нажатий клавиш курсора, иногда вырезают знак пунктуации или возврат каретки, что портит исходный документ. Я только хочу вытащить слова.

Кроме того, я хотел бы иметь возможность зациклить команду, чтобы она повторялась до конца документа.

И, наконец, есть ли способ, с помощью которого макрос может спросить пользователя, какой интервал он хочет использовать для количества шагов, чтобы пропустить вперед?

---

Человеку, который ответил:

Спасибо Вам большое.

Лучше ограничить выделение чем-то более 3-мя символами, но я хочу, чтобы макрос вырезал слова из текста без разбора (цель - изучение языка, и часто в словах меньшего размера требуется акцент в такой деятельности).

Я нашел код, написанный кем-то другим, который мог бы работать, но я не понимаю, как реализовать его в моем макросе с остальными командами:

    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

Функция должна находиться «над» остальным кодом, верно? Но я получаю сообщение об ошибке «аргумент не является обязательным» при запуске. Я хочу выделить каждый n-й выбор, проверить, является ли оно реальным словом, вырезано ли оно, и вставить его в другой документ, а если нет, перейти к следующему выделению и проверять, пока оно не найдет слово.

Answer 1

Во-первых, я бы предпочел, чтобы слова были вставлены в текстовое поле или таблицу в том же документе, а не вставлены в другой документ вообще.

После завершения макроса вы можете просто добавить несколько строк, чтобы скопировать все содержимое нового документа в старый.

Конечно, если во время работы макроса не будет открыт «документ 4», он тоже не будет работать.

Не ссылайтесь на существующий документ, создайте новый при запуске макроса

Dim NewDoc as Document
Set NewDoc = Application.Documents.Add

удержание управления и пропуск 8 нажатий клавиш курсора иногда приводит к обрезанию знака препинания или возврата каретки, что приводит к путанице в оригинальном документе. Я только хочу вытащить слова.

Не самое элегантное решение, но вы можете, например, искать слова длиной более 3 символов, это исключит большинство ваших проблем.

...
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Do until len(Selection) > 3 OR Selection.Bookmarks.Exists("\EndOfDoc")
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Loop
If Not Selection.Bookmarks.Exists("\EndOfDoc") Then
    Selection.Cut
...

Кроме того, я хотел бы иметь возможность зациклить команду, чтобы она повторялась до конца документа.

Добавьте цикл вокруг вашего цикла:

Do 
    ...
Loop While Selection.Bookmarks.Exists("\EndOfDoc")

Есть ли способ, с помощью которого макрос может спросить пользователя, какой интервал он хочет использовать для количества шагов, чтобы пропустить вперед?

Вы можете использовать InputBox для запроса ввода пользователя:

Dim SkipWordCount as Integer

SkipWordCount = CInt(InputBox("Enter number of words to be skipped"))

Loop
    Selection.MoveRight Unit:=wdWord, Count:= SkipWordCount
    ...