Sub AutoTransliterate()
Application.ScreenUpdating = False
Dim Rng As Range, oSuggestions As Variant
Const StrDict As String = "CustomDictionary"
For Each Rng In ActiveDocument.Range.SpellingErrors
  With Rng
    If .GetSpellingSuggestions(StrDict).Count > 0 Then
      Set oSuggestions = .GetSpellingSuggestions(StrDict)
      .Text = oSuggestions(1)
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub