0

I am really new to macros in Word but I want to automate a process and I wander if someone can help me out.

I am a language teacher. I want to take a story that my class has created, select every 8th (or nth) word and cut it out of the document. I then want to replace the extracted word with a 'blank' (i.e. 8 underscores which the student will write on) and then paste the extracted word somewhere else.

I had a mess around with this and came up with the following:

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

There are a few problems with this. First, I would rather the words are pasted into a textbox or table in the same document and not pasted into another document altogether. I couldn't figure out how to do this. Of course if there is no 'document 4' open at the time of running the macro it wouldn't function too.

Second problem is that just by holding control and skipping on 8 cursor key presses will sometimes cut out a punctuation mark or a carriage return, which messes up the original document. I only want to pull out words.

Also, I would like to be able to loop the command so that it repeats until the end of the document.

And finally, is there a way I can have the macro ask the user what interval they want to use for the number of steps to skip forward?


To the person who replied:

Thank you very much indeed.

Limiting the selection to anything over 3 characters is better, but I want the macro to cut words out of the text indiscriminately (the purpose is for language teaching and it's often the smaller words that can require emphasis in such an activity).

I found some code written by someone else that might work, but I don't understand how to implement it in my macro with the rest of the commands:

    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

The function should sit 'above' the rest of the code right? But I get an error 'argument not optional' when I run it. I want to highlight every nth selection, check if it's an actual word, if it is cut and paste it into the other document, and if not move on to the next selection and check until it finds a word.

0

First, I would rather the words are pasted into a textbox or table in the same document and not pasted into another document altogether.

After your macro completed, you can just add a few lines to copy entire content of new document to the old one

Of course if there is no 'document 4' open at the time of running the macro it wouldn't function too.

Don't refer to existing document, create a new one when you start your macro

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

holding control and skipping on 8 cursor key presses will sometimes cut out a punctuation mark or a carriage return, which messes up the original document. I only want to pull out words.

Not the most elegant solution, but you can e.g. look for words longer than e.g. 3 characters, this will exclude majority of your issues.

...
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
...

Also, I would like to be able to loop the command so that it repeats until the end of the document.

Add a loop around your loop:

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

is there a way I can have the macro ask the user what interval they want to use for the number of steps to skip forward?

You can use InputBox to ask for user input:

Dim SkipWordCount as Integer

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

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.