Написать макрос Word, меняющий раскладку

 Sub ToggleKeyboardLayoutImproved() 
    Dim engLayout As String, rusLayout As String 
    Dim specialEngChars As String, specialRusChars As String 
    Dim i As Long 
    Dim selectedText As String 
    Dim resultText As String 
    Dim isCharFound As Boolean 
 
    engLayout = "QWERTYUIOP[]ASDFGHJKL;'ZXCVBNM,./" & _ 
                "qwertyuiop{}asdfghjkl:""zxcvbnm<>?/" 
    rusLayout = "ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ." & _ 
                "йцукенгшщзхъфывапролджэячсмитьбю," 
  
    specialEngChars = "[{]};:'"",<.>/?`~" 
    specialRusChars = "хХъЪжЖэЭбБюЮ.," & "ёЁ" 
 
    selectedText = Selection.Text 
    resultText = "" 
     
    For i = 1 To Len(selectedText) 
        Dim c As String 
        c = Mid(selectedText, i, 1) 
        Dim pos As Integer 
        isCharFound = False 
         
        pos = InStr(specialEngChars, c) 
        If pos > 0 Then 
            resultText = resultText & Mid(specialRusChars, pos, 1) 
            isCharFound = True 
        Else 
            pos = InStr(specialRusChars, c) 
            If pos > 0 Then 
                resultText = resultText & Mid(specialEngChars, pos, 1) 
                isCharFound = True 
            End If 
        End If 
 
        If Not isCharFound Then 
            pos = InStr(engLayout, c) 
            If pos > 0 Then 
                resultText = resultText & Mid(rusLayout, pos, 1) 
                isCharFound = True 
            End If 
        End If 
         
        If Not isCharFound Then 
            pos = InStr(rusLayout, c) 
            If pos > 0 Then 
                resultText = resultText & Mid(engLayout, pos, 1) 
            Else 
                resultText = resultText & c 
            End If 
        End If 
    Next i 
 
    Selection.Text = resultText 
End Sub