insert a function to a subroutine

51 views Asked by At

I need to insert a transliteration function to a subroutine that copies the contents of a document, inserts it into a temporary document and then the transliteration function should be performed. then it will be copied from the temporary document to the main one below the source text. i dont know how to insert function in a sub. which objects/methods/properties should i use?

function:

Function f(ByVal txt As String) As String
  Dim RUS As String, ENG As Variant, i As Integer, b As Boolean
  ENG = Array("shh", "e'", "y'", "''", "ya", "yo", "yu", "zh","ch","sh", "a", "b", "v", "g", "d", "e", "z", "i", "j", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "x", "c", "'", "Shh", "E'", "Y'", "Ya", "Yo", "Yu", "Zh", "Ch", "Sh", "A", "B", "V", "G", "D", "E", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F", "X", "C")
  RUS = "щэыъяёюжчшабвгдезийклмнопрстуфхцьЩЭЫЯЁЮЖЧШАБВГДЕЗИЙКЛМНОПРСТУФХЦ"
  For i = 0 To 63
    If InStr(1, txt, Mid$(RUS, i + 1, 1), vbBinaryCompare) Then b = True
    temp = Mid$(RUS, i + 1, 1)
    txt = Replace$(txt, IIf(b, temp, ENG(i)), IIf(b, ENG(i), temp))
  Next
    f = txt
End Function

subroutine:

Sub test()
  Dim tempDoc As Document, doc As Document
  Set doc = ActiveDocument
  Set tempDoc = Documents.Add
    
  doc.Range.Copy
  tempDoc.Activate
  Selection.Paste
 

  'insert function here (i guess)
 

  tempDoc.Range.Copy
  doc.Activate
  With Selection
    .EndKey Unit:=wdStory
    .Collapse Direction:=wdCollapseEnd
  End With
  Selection.TypeParagraph
  Selection.Paste
  tempDoc.Close 0
  ActiveDocument.Range.Characters.Last.Previous.Delete
End Sub
1

There are 1 answers

0
Timothy Rylatt On

For example:

Sub test()
  Dim doc As Document: Set doc = ActiveDocument
    
  doc.Characters.Last.Text = vbcr & f(doc.Range.Text)

End Sub