Option Compare Database
Option Explicit

Public Sub RunToTranslitAllProject()
Dim fm
Dim frm, ctl, F As Form
Dim m As Module
Dim mdle, i, lne


For Each frm In CurrentProject.AllForms
DoCmd.OpenForm frm.Name, acDesign, , , , acHidden
Set F = Forms(frm.Name)
    For Each ctl In F.Controls
        If ctl.Name Like "[а-Я]*" Then
            ctl.Name = Transliteration(ctl.Name)
            Debug.Print "форма " & frm.Name & " Контрол " & ctl.Name
        End If
    Next ctl
Set fm = F.Module
    For i = 1 To fm.CountOfLines
        lne = fm.Lines(i, 1)
        If Not lne Like "'*" Then
            lne = Transliteration(lne)
             fm.ReplaceLine i, lne
            
        End If
    Next i
    
    
    
    
    
DoCmd.Close acForm, frm.Name
Next frm
Set F = Nothing


For Each mdle In CurrentProject.AllModules
DoCmd.OpenModule mdle.Name
Set m = Modules(mdle.Name)
If m.Name = "translit" Then GoTo nxt:
    For i = 1 To m.CountOfLines
        lne = m.Lines(i, 1)
        If Not lne Like "'*" Then
            lne = Transliteration(lne)
             m.ReplaceLine i, lne
            
        End If
    Next i
nxt:
'mdle = mdle + 1
DoCmd.Close acModule, mdle.Name
Next mdle


End Sub

Function Transliteration(sWord)

'by Sergey_New 

Dim n, s, z
  Transliteration = Trim(sWord & "")
  If Transliteration = "" Then Exit Function

Dim aRL(32, 1) ' кириллица - латиница
  aRL(0, 0) = "а": aRL(0, 1) = "a"
  aRL(1, 0) = "б": aRL(1, 1) = "b"
  aRL(2, 0) = "в": aRL(2, 1) = "v"
  aRL(3, 0) = "г": aRL(3, 1) = "g"
  aRL(4, 0) = "д": aRL(4, 1) = "d"
  aRL(5, 0) = "е": aRL(5, 1) = "e"
  aRL(6, 0) = "ё": aRL(6, 1) = "jo"
  aRL(7, 0) = "ж": aRL(7, 1) = "zh"
  aRL(8, 0) = "з": aRL(8, 1) = "z"
  aRL(9, 0) = "и": aRL(9, 1) = "i"
  aRL(10, 0) = "й": aRL(10, 1) = "jj"
  aRL(11, 0) = "к": aRL(11, 1) = "k"
  aRL(12, 0) = "л": aRL(12, 1) = "l"
  aRL(13, 0) = "м": aRL(13, 1) = "m"
  aRL(14, 0) = "н": aRL(14, 1) = "n"
  aRL(15, 0) = "о": aRL(15, 1) = "o"
  aRL(16, 0) = "п": aRL(16, 1) = "p"
  aRL(17, 0) = "р": aRL(17, 1) = "r"
  aRL(18, 0) = "с": aRL(18, 1) = "s"
  aRL(19, 0) = "т": aRL(19, 1) = "t"
  aRL(20, 0) = "у": aRL(20, 1) = "u"
  aRL(21, 0) = "ф": aRL(21, 1) = "f"
  aRL(22, 0) = "х": aRL(22, 1) = "kh"
  aRL(23, 0) = "ц": aRL(23, 1) = "c"
  aRL(24, 0) = "ч": aRL(24, 1) = "ch"
  aRL(25, 0) = "ш": aRL(25, 1) = "sh"
  aRL(26, 0) = "щ": aRL(26, 1) = "shh"
  aRL(27, 0) = "ъ": aRL(27, 1) = "'"
  aRL(28, 0) = "ы": aRL(28, 1) = "y"
  aRL(29, 0) = "ь": aRL(29, 1) = "'"
  aRL(30, 0) = "э": aRL(30, 1) = "eh"
  aRL(31, 0) = "ю": aRL(31, 1) = "ju"
  aRL(32, 0) = "я": aRL(32, 1) = "ja"

  For n = 0 To 32
    s = aRL(n, 0)
    z = aRL(n, 1)
    Transliteration = Replace(Transliteration, s, z) ' строчные буквы
    Transliteration = Replace(Transliteration, UCase(s), UCase(Mid(z, 1, 1)) & Mid(z, 2)) ' прописные буквы
  Next
End Function