Microsoft Office Forums - View Single Post - Converting a left to right doc to a right to left

macropod · 04-23-2012, 05:42 PM

Hi seli,

You might be able to get the result you're after via a macro like:

Code:

Sub ReverseParagraphSentenceText()
Dim oPara As Paragraph, Rng As Range, RngStart As Range, RngEnd As Range, i As Long
For Each oPara In ActiveDocument.Paragraphs
  Application.ScreenUpdating = False
  If InStr(Trim(oPara.Range.Text), " ") > 0 Then
    Set Rng = oPara.Range
    With Rng
      .End = .End - 1
      While .Characters.Last.Text Like "[ " & vbTab & Chr(11) & "]"
        .End = .End - 1
        If .End = .Start Or InStr(Trim(.Text), " ") = 0 Then GoTo NextPara
      Wend
      While .Characters.First.Text Like "[ " & vbTab & Chr(11) & "]"
        .Start = .Start + 1
        If .Start = .End Or InStr(Trim(.Text), " ") = 0 Then GoTo NextPara
      Wend
      Set RngStart = Rng.Characters.First
      Set RngEnd = Rng.Characters.Last
      RngStart.Collapse wdCollapseStart
      For i = UBound(Split(.Text, " ")) To 1 Step -1
        RngStart.Collapse wdCollapseEnd
        RngEnd.Start = .Start + InStrRev(.Text, Split(.Text, " ")(i)) - 1
        RngEnd.Cut
        RngStart.Paste
        .Start = RngStart.End
      Next
      .Characters.Last.Text = vbNullString
    End With
  End If
  Application.ScreenUpdating = True
  Application.ScreenRefresh
NextPara:
Next
Set Rng = Nothing: Set RngEnd = Nothing: Set RngStart = Nothing
End Sub

The above macro works at the paragraph level. To reverse text at the sentence level only, use:

Code:

Sub ReverseText()
Dim oSent As Range, Rng As Range, RngStart As Range, RngEnd As Range, i As Long
For Each oSent In ActiveDocument.Sentences
  Application.ScreenUpdating = False
  If InStr(Trim(oSent.Text), " ") > 0 Then
    Set Rng = oSent
    With Rng
      .End = .End - 1
      While .Characters.Last.Text Like "[. " & vbTab & vbCr & Chr(11) & "]"
        .End = .End - 1
        If .End = .Start Or InStr(Trim(.Text), " ") = 0 Then GoTo NextPara
      Wend
      While .Characters.First.Text Like "[ " & vbTab & Chr(11) & "]"
        .Start = .Start + 1
        If .Start = .End Or InStr(Trim(.Text), " ") = 0 Then GoTo NextPara
      Wend
      Set RngStart = Rng.Characters.First
      Set RngEnd = Rng.Characters.Last
      RngStart.Collapse wdCollapseStart
      For i = UBound(Split(.Text, " ")) To 1 Step -1
        RngStart.Collapse wdCollapseEnd
        RngEnd.Start = .Start + InStrRev(.Text, Split(.Text, " ")(i)) - 1
        RngEnd.Cut
        RngStart.Paste
        .Start = RngStart.End
      Next
    End With
  End If
  Application.ScreenUpdating = True
  Application.ScreenRefresh
NextPara:
Next
Set Rng = Nothing: Set RngEnd = Nothing: Set RngStart = Nothing
End Sub

For installation/usage instructions, see: http://www.gmayor.com/installing_macro.htm