Мой друг в совершенстве владеет персидским языком (фарси), но его не устраивает стандартная раскладка клавиатуры при переключении на этот язык. Он попросил ее поменять. Для ранних версий MS Word у него уже был макрос на VBA, который работал следующим образом. Пользователь набирает текст латиницей, выделяет набранный текст и запускает макрос. Тот пробегает по выделенным символам и заменяет их на нужный символ персидского алфавита. Но в новых версиях MS Word данный макрос работать отказывался. И друг попросил меня написать новый.
Для написания макроса была любезно предоставлена таблица символов персидского алфавита, их представления в кодировке Unicode и символы латинского алфавита, которым надо было сделать соответствие. При этом нужно учесть одну особенность персидского языка. Написание буквы зависит от ее положении в тексте. Например: клавиша S сопоставляется букве ﺲ(син).
Признаться честно, я владею VBA чуть хуже, чем ни как. Поэтому посмотрел как пишет символы фарси сам Word. Оказалось, что, например, ту же букву син (ﺱ) он вне зависимости от позиции вставляет одним и тем же Unicode кодом U+0633 и сам же его правильно отрисовывает в зависимости от позиции. Так же и с остальными символами. По стандарту Unicode здесь срабатывает особый тип модифицирующих символов — селекторы варианта начертания.
С этим знанием остальное уже дело техники: переназначить клавиши. Word все сделает сам.
Для написания макроса была любезно предоставлена таблица символов персидского алфавита, их представления в кодировке Unicode и символы латинского алфавита, которым надо было сделать соответствие. При этом нужно учесть одну особенность персидского языка. Написание буквы зависит от ее положении в тексте. Например: клавиша S сопоставляется букве ﺲ(син).
- ﺲ = U+FEB1, изолировано
- ﺴ = U+FEB3, в начале слова
- ﺳ = U+FEB4, в середине слова
- ﺱ = U+FEB2, в конце слова
Признаться честно, я владею VBA чуть хуже, чем ни как. Поэтому посмотрел как пишет символы фарси сам Word. Оказалось, что, например, ту же букву син (ﺱ) он вне зависимости от позиции вставляет одним и тем же Unicode кодом U+0633 и сам же его правильно отрисовывает в зависимости от позиции. Так же и с остальными символами. По стандарту Unicode здесь срабатывает особый тип модифицирующих символов — селекторы варианта начертания.
С этим знанием остальное уже дело техники: переназначить клавиши. Word все сделает сам.
Option Explicit
' Текущая кодировка клавиатуры и формат расположения параграфа.
Dim localKeyboard As Long
Dim ParagraphFormatAligment As Long
' Процедура для запуска макроса.
Public Sub farsi()
Initialize
End Sub
' Назначение символов фарси клавишам.
'''''''''''''''''''''''''''''''''''''''''''
Public Sub Initialize()
' Сохраняем текущие настройки клавиатуры.
localKeyboard = Application.Keyboard
' Сохраняем смещение параграфа.
ParagraphFormatAligment = Selection.ParagraphFormat.Alignment
' Устанавливаем новую конфигурацию.
Selection.LtrPara
' Раскладка фарси.
Application.Keyboard (1065)
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
CustomizationContext = NormalTemplate
' Назначаем клавиши свою процедуру.
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyA), _
KeyCategory:=wdKeyCategoryMacro, Command:="a"
KeyBindings.Add KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyA), _
KeyCategory:=wdKeyCategoryMacro, Command:="shiftA"
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyB), _
KeyCategory:=wdKeyCategoryMacro, Command:="b"
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyP), _
KeyCategory:=wdKeyCategoryMacro, Command:="p"
KeyBindings.Add KeyCategory:=wdKeyCategoryMacro, _
Command:="shiftBackSingleQuote", _
KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyBackSingleQuote)
' И так далее для каждой интересующей клавиши.
' ............................................
' Debugging message.
MsgBox KeyBindings.Count & " клавиш назначено в коллекции KeyBindings"
End Sub
' Процедуры, назначаемые клавишам.
Public Sub a()
Selection.TypeText Text:=ChrW(1575)
End Sub
Public Sub shiftA()
Selection.TypeText Text:=ChrW(1570)
End Sub
Public Sub b()
Selection.TypeText Text:=ChrW(1576)
End Sub
Public Sub p()
Selection.TypeText Text:=ChrW(1662)
End Sub
Public Sub shiftBackSingleQuote()
Selection.TypeText Text:=ChrW(1569)
End Sub
' И так далее для каждой интересующей клавиши.
' ............................................
'Возвращаем клавишам их функциональность обратно.
''''''''''''''''''''''''''''''''''''''''''''''''''
' Данную процедуру необходимо вызвать для прекращения работы максроса.
Public Sub UnInitialize()
If Not KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyA)) Is Nothing Then
KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyA)).Clear
End If
If Not KeyBindings.Key(KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyA)) Is Nothing Then
KeyBindings.Key(KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyA)).Clear
End If
If Not KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyB)) Is Nothing Then
KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyB)).Clear
End If
If Not KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyP)) Is Nothing Then
KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyP)).Clear
End If
If Not KeyBindings.Key(KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyBackSingleQuote)) Is Nothing Then
KeyBindings.Key(KeyCode:=BuildKeyCode(Arg1:=wdKeyShift, Arg2:=wdKeyBackSingleQuote)).Clear
End If
' Возвращаем настройки клавиатуры.
Selection.RtlPara
Application.Keyboard (localKeyboard)
Selection.ParagraphFormat.Alignment = ParagraphFormatAligment
' Debuging message
MsgBox KeyBindings.Count & " клавиш назначено в коллекции KeyBindings"
End Sub