user2267808
user2267808

Reputation: 23

Word VBA: Moving textstring from the end of a paragraph to the beginning of the paragraph

I'm new to VBA. I have several long documents where a citation or a document number appears at the end of a paragraph. Luckily, these citations and document are enclosed in parentheses, which should make it easy to isolate. I need to move the content of those parentheses (including the parentheses themselves) to the front of each paragraph and then add two spaces after the closing parenthesis.

For example:

This is my text in Paragraph 1. (http://nytimes.com)

This is my text in Paragraph 2. (1.b.3B)

Should look like:

(http://nytimes.com) This is my text in Paragraph 1.

(1.b.3B) This is my text in Paragraph 2.

I found the answer in the following link useful, but can't seem to apply it to my case: Get paragraph no where txt is found, and move text to end of paragraph using Word 2010 vba

Many thanks in advance.

Here's what I have up to now, but the script just doesn't seem to run:

Sub Test1()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.

For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.

With Selection.Find
        .ClearFormatting
        .Text = "\(*\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
End With

If currRng.Find.Execute Then

With Selection
    .Select
    .Cut
    .StartOf Unit:=wdParagraph
    .Paste
    .InsertAfter "  "
End With

End If

Next currPara

End Sub

Upvotes: 2

Views: 4679

Answers (1)

Kazimierz Jawor
Kazimierz Jawor

Reputation: 19067

You were very close to correct solution to move simple text. But, what I realised, it was a problem to move hyperlinks as syntax "\(*\)" didn't recognise hyperlinks. Therefore I put some additional small modifications. That works for me in Word 2010:

Sub Test1_Tested_incl_Hyper()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.

For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
currRng.Select
With Selection.Find
    .ClearFormatting
    .Text = "\("
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute
End With

If Selection.Find.Found Then

With currDoc.Range(Selection.Range.Start, currPara.Range.End - 1)
    .Select
    .Cut
    .StartOf Unit:=wdParagraph
    .Paste
    .InsertAfter "  "
End With

End If

Next currPara

End Sub

EDIT- code for footers

Sub Test1_for_Footers()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.StoryRanges(wdPrimaryFooterStory)
Dim currPara As Paragraph
Dim strText As String

For Each currPara In docRng.Paragraphs

currPara.Range.Select
With Selection.Find
    .ClearFormatting
    .Text = "\("
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute
End With

If Selection.Find.Found Then
Selection.Extend ")"

With Selection
    .Select
    .Cut
    .StartOf Unit:=wdParagraph
    .Paste
    .InsertAfter "  "
End With

End If

Next currPara

End Sub

Upvotes: 1

Related Questions