none
Word Loop for Warp text RRS feed

  • Question

  • I tried a Loop program, but Word keeps getting hung. What do I need to do to fix this Macro.

    Sub ARAdjust()
     With Selection.Find
        .Forward = True
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = wdFindContinue
        .Execute FindText:="015@"
        Selection.HomeKey Unit:=wdLine
        Selection.TypeBackspace
        Selection.MoveDown Unit:=wdLine, Count:=2
        Selection.HomeKey Unit:=wdLine
        End With
        Do Until Done
            If Selection.Find.Found Then
            Selection.HomeKey Unit:=wdLine
            Selection.TypeBackspace
            Selection.MoveDown Unit:=wdLine, Count:=2
            Selection.HomeKey Unit:=wdLine
            Else
                Done = True
            End If
        Loop
    '
    ' ARAdjust Macro
    '
    '

    End Sub

    Thursday, June 9, 2016 7:06 PM

All replies

  • Better than showing us code that does not work would be to explain what you want done.  The code is hanging Word because there is no way for it to change  Selection.Find.Found to False within the loop, so you get into an infinite loop.  At the least, you need to include the top of your code (or another Find) in your loop so that the Find will be included and .Found can actually be set to False at some point.

    Thursday, June 9, 2016 7:32 PM
  • I ran report into a text document, however, the text document is causing a line break and it does not wrap around. I need to import this into Excel as single line entries instead of two or three line entries per string. I built the code to remove the line break so Excel can recognize a single line string.
    Thursday, June 9, 2016 7:42 PM
  • I have tried several different methods of inputting the Selection.Find.Found = False, along with modifying the script, but the compiler does not like what I am doing. Any suggestions?
    Thursday, June 9, 2016 9:33 PM
  • You can "replace all" instead of looping:

    Sub TestMacro()
        Selection.WholeStory
        With Selection.Find

            'Change line returns to spaces

            .Text = "^p"
            .Replacement.Text = " "
            .Execute Replace:=wdReplaceAll

            'Remove any doubled spaces

            .Text = "  "
            .Replacement.Text = " "
            .Execute Replace:=wdReplaceAll
         End With
    End Sub



    Friday, June 10, 2016 12:32 PM