Здравствуйте, Иванов Евгений Витальевич!


Приложение:

Sub punto()
'
' punto Macro
'
'
Dim str As String
Dim str1 As String
str = Application.Selection.Text
Dim dlina As Integer
dlina = Len(str)
Dim rus As String
rus = "йцукенгшщзхъфывапролджэячсмитьбю"
Dim eng As String
eng = "qwertyuiop[]asdfghjkl;'zxcvbnm,."
Dim lang As Boolean 'true - russian, false - latin
If InStr(1, eng, Mid(str, 1, 1), VbCompareMethod.vbTextCompare) > 0 Then
lang = False 'english
Else
lang = True 'russian
End If

For i = 1 To dlina
lngPos = InStr(1, rus, Mid(str, i, 1), VbCompareMethod.vbTextCompare)
If lngPos > 0 Then 'russian letter
str1 = str1 + Mid(eng, lngPos, 1)
Else
lngPos = InStr(1, eng, Mid(str, i, 1), VbCompareMethod.vbTextCompare)
If lngPos > 0 Then ' english letter or ,.
If Mid(str, i, 1) = "." Then ' .
If lang = False And Mid(str, i + 1, 1) = " " And Mid(str, i + 2, 1) > "Z" Then 'единственное условие, при котором . преобразуется в ю
str1 = str1 + "ю"
Else
str1 = str1 + Mid(str, i, 1) 'Точка остается
End If
Else: str1 = str1 + Mid(rus, lngPos, 1)
End If
If Mid(str, i, 1) = "," Then
If lang = False And Mid(str, i + 1, 1) = " " And Mid(str, i + 2, 1) < "Z" Then 'единственное условие, при котором . преобразуется в ю
str1 = str1 + "б"
Else
str1 = str1 + Mid(str, i, 1)
End If
End If
Else
str1 = str1 + Mid(str, i, 1)
End If
End If
Next i
Application.Selection = str1
End Sub