Блин, забыл что тут ограничено символов (((


Case "а": c = "f"
Case "п": c = "g"
Case "р": c = "h"
Case "о": c = "j"
Case "л": c = "k"
Case "д": c = "l"
Case "ж": c = ";"
Case "э": c = "'"
Case "я": c = "z"
Case "ч": c = "x"
Case "с": c = "c"
Case "м": c = "v"
Case "и": c = "b"
Case "т": c = "n"
Case "ь": c = "m"
Case "б": c = ","
Case "ю": c = "."

Case "Й": c = "Q"
Case "Ц": c = "W"
Case "У": c = "E"
Case "К": c = "R"
Case "Е": c = "T"
Case "Н": c = "Y"
Case "Г": c = "U"
Case "Ш": c = "I"
Case "Щ": c = "O"
Case "З": c = "P"
Case "Х": c = "{"
Case "Ъ": c = "}"
Case "Ф": c = "A"
Case "Ы": c = "S"
Case "В": c = "D"
Case "F": c = "F"
Case "П": c = "G"
Case "Р": c = "H"
Case "О": c = "J"
Case "Л": c = "K"
Case "Д": c = "L"
Case "Ж": c = ":"
Case "Э": c = """"
Case "Я": c = "Z"
Case "Ч": c = "X"
Case "С": c = "C"
Case "М": c = "М"
Case "И": c = "B"
Case "Т": c = "N"
Case "Ь": c = "M"
Case "Б": c = "<"
Case "Ю": c = ">"
End Select
s1 = s1 & c
Next
Selection.TypeText Text:=s1
End Sub