Interacting with a document without using selection

userQvfm1 0
Viewed 27

I have a transliteration function (from cyrillic to latin). I will use this function in a unviersal subroutine (with text of any lenght). This sub must to copy the source text, transliterate (from cyrillic to latin) and paste it below without any formatting changes and without using selection. The next step is reverse transliteration (again copy and paste below). There must be 3 textes in the final. I kinda know how to realize it, but i don't know what i should use instead of selection.

an example of what it have to be in the final is in the picture*

P.S. i tried use For Each word In ActiveDocument.Range.Words but it works bad with reverse transliteration (exactly that. without it, the function works perfectly in debugging) P.P.S. sorry for mistakes in the text, i'm not a native speaker

transliteration vba ms-word
1 Answers

Since you haven't posted any actual translation code, I'll leave you to add that to the code below:

Sub Translate()
Application.ScreenUpdating = False
Dim p As Long, w As Long
With ActiveDocument.Range
  Do While .Characters.Last.Previous = vbCr
    .Characters.Last.Previous.Delete
  Loop
  .InsertAfter vbCr
  'Duplicate Content
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = "^13{2,}"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    .Text = "[!^13]@^13"
    .Replacement.Text = "^&^&^p"
    .Execute Replace:=wdReplaceAll
  End With
  .Characters.Last.Previous.Delete
  'Loop through duplicated paragraphs
  For p = .Paragraphs.Count - 1 To 2 Step -3
    With .Paragraphs(p).Range
      For w = .Words.Count To 1 Step -1
        'Translate each word
        'Insert translation code here
      Next
      'Duplicate translated paragraph
      .Characters.Last.Next.FormattedText = .FormattedText
    End With
  Next
  .Characters.Last.Previous.Delete
  'Loop through duplicated paragraphs
  For p = .Paragraphs.Count To 3 Step -3
    With .Paragraphs(p).Range
      For w = .Words.Count To 1 Step -1
        'Reverse translate each word
        'Insert translation code here
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Note that any empty paragraphs are deleted so as to not compromise the process.

macropod0
Related