: VBA Запитання та Відповіді (Готові рішення); 24 липня 2022; Перегляди: 429

Макрос заміни латинських букв кирилицею і навпаки

Представляю вашій увазі набір макросів для зміни розкладки клавіатури на той випадок, якщо ви надрукуєте текст не тими літерами.

Використовуючи ці макроси і зробивши лише кілька кліків, ви зможете:

Замінити англійські літери на російські у всьому тексті
Замінити англійські літери на українські у всьому тексті
Замінити російські літери на англійські у всьому тексті
Замінити російські літери на українські у всьому тексті
Замінити українські літери на англійські у всьому тексті
Замінити українські літери на російські у всьому тексті
Замінити англійські літери на російські у виділеному фрагменті тексту
Замінити англійські літери на українські у виділеному фрагменті тексту
Замінити російські літери на англійські у виділеному фрагменті тексту
Замінити російські літери на українські у виділеному фрагменті тексту
Замінити українські літери на англійські у виділеному фрагменті тексту
Замінити українські літери на російські у виділеному фрагменті тексту

Пояснення до коду

Перші приклади коду виконують повну перевірку всього тексту і змінюють у ньому всі символи на ті, які потрібно. Для того, щоб виконати заміну символів тільки у виділеному фрагменті тексті, достатньо замінити один рядок:

Set rDoc=ActiveDocument.Range на Set rDoc=Selection.Range

Макрос заміни англійських букв на російські у всьому тексті

'Автоматична конвертація всіх символів у тексті з англійських на російські
Sub autoConvertEngToRu()
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв які потрібно міняти (sLat - це англійські символи, які потрібно міняти. sRus - це російські символи, які підставляються замість англійських)
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "^", "&", "<", ">", "?", "№", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
sRus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "ё", "№", ";", ":", "?", "Б", "Ю", ",", "#", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Ё", Chr(34))
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'замінити всі англійські символи на відповідні російські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sLat) To UBound(sRus)
      .Text = sLat(i)
      .Replacement.Text = sRus(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни англійських букв на українські у всьому тексті

'Автоматична конвертація всіх символів у тексті з англійських на українські
Sub autoConvertEngToUa()
Dim i As Integer
Dim sLat As Variant
Dim sUa As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв, які потрібно міняти (sLat - це англійські символи, які потрібно міняти. sUa - це українські символи, які підставляються замість англійських)
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "^", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
sUa = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ї", "ф", "і", "в", "а", "п", "р", "о", "л", "д", "ж", "є", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "'", "№", ";", ":", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ї", "Ф", "І", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Є", "Я", "Ч", "С", "М", "И", "Т", "Ь", "?", Chr(34))
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'замінити всі англійські символи на відповідні українські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sLat) To UBound(sUa)
      .Text = sLat(i)
      .Replacement.Text = sUa(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни російських букв на англійські у всьому тексті

'Автоматична конвертація всіх символів у тексті з російських на англійські
Sub autoConvertRuToEng()
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв, які потрібно міняти (sRus - це російські символи, які потрібно міняти. sLat - це англійські символи, які потрібно підставити замість російських)
sRus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "ё", "№", ";", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Ё", Chr(34))
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі російські символи на відповідні англійські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sRus) To UBound(sLat)
      .Text = sRus(i)
      .Replacement.Text = sLat(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни російських букв на українські у всьому тексті

'Автоматична конвертація всіх символів у тексті з російських на українські
Sub autoConvertRuToUa()
Dim i As Integer
Dim sUa As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв, які потрібно міняти (sRus - це російські символи, які потрібно міняти. sUa - це українські символи, які підставляються замість російських)
sRus = Array("ё", "ъ", "ы", "э", "Ё", "Ъ", "Ы", "Э")
sUa = Array("'", "ї", "і", "є", "?", "Ї", "І", "Є")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі російські символи на відповідні українські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sRus) To UBound(sUa)
      .Text = sRus(i)
      .Replacement.Text = sUa(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни українських букв на англійські у всьому тексті

'Автоматична конвертація всіх символів у тексті з українських на англійські
Sub autoConvertUaToEng()
Dim i As Integer
Dim sLat As Variant
Dim sUa As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв, які потрібно міняти (sUa - це українські символи, які потрібно міняти. sLat - це англійські символи, які потрібно підставити замість українських)
sUa = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ї", "ф", "і", "в", "а", "п", "р", "о", "л", "д", "ж", "є", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "'", "№", ";", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ї", "Ф", "І", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Є", "Я", "Ч", "С", "М", "И", "Т", "Ь", "?", Chr(34))
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі українські символи на відповідні англійські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sUa) To UBound(sLat)
      .Text = sUa(i)
      .Replacement.Text = sLat(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни українських букв на російські у всьому тексті

'Автоматична конвертація всіх символів у тексті з українських на російські
Sub autoConvertUaToRu()
Dim i As Integer
Dim sUa As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range
'Список букв, які потрібно міняти (sUa - це українські символи, які потрібно міняти. sRus - це російські символи, які підставляються замість українських)
sUa = Array("'", "ї", "і", "є", "?", "Ї", "І", "Є")
sRus = Array("ё", "ъ", "ы", "э", "Ё", "Ъ", "Ы", "Э")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'замінюємо всі українські символи на відповідні російські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sUa) To UBound(sRus)
      .Text = sUa(i)
      .Replacement.Text = sRus(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни англійських букв на російські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з англійських на російські
Sub convertEngToRu()
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв які потрібно міняти (sLat - це англійські символи, які потрібно міняти. sRus - це російські символи, які підставляються замість англійських)
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "^", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
sRus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "ё", "№", ";", ":", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Ё", Chr(34))
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі англійські символи на відповідні російські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sLat) To UBound(sRus)
      .Text = sLat(i)
      .Replacement.Text = sRus(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни англійських букв на українські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з англійських на українські
Sub convertEngToUa()
Dim i As Integer
Dim sLat As Variant
Dim sUa As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв, які потрібно міняти (sLat - це англійські символи, які потрібно міняти. sUa - це українські символи, які підставляються замість англійських)
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "^", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
sUa = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ї", "ф", "і", "в", "а", "п", "р", "о", "л", "д", "ж", "є", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "'", "№", ";", ":", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ї", "Ф", "І", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Є", "Я", "Ч", "С", "М", "И", "Т", "Ь", "?", Chr(34))
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі англійські символи на відповідні українські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sLat) To UBound(sUa)
      .Text = sLat(i)
      .Replacement.Text = sUa(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни російських букв на англійські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з російських на англійські
Sub convertRuToEng()
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв, які потрібно міняти (sRus - це російські символи, які потрібно міняти. sLat - це англійські символи, які потрібно підставити замість російських)
sRus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "ё", "№", ";", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Ё", Chr(34))
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі російські символи на відповідні англійські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sRus) To UBound(sLat)
      .Text = sRus(i)
      .Replacement.Text = sLat(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни російських букв на українські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з російських на українські
Sub convertRuToUa()
Dim i As Integer
Dim sUa As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв, які потрібно міняти (sRus - це російські символи, які потрібно міняти. sUa - це українські символи, які підставляються замість російських)
sRus = Array("ё", "ъ", "ы", "э", "Ё", "Ъ", "Ы", "Э")
sUa = Array("'", "ї", "і", "є", "?", "Ї", "І", "Є")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'міняємо всі російські символи на відповідні українські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sRus) To UBound(sUa)
      .Text = sRus(i)
      .Replacement.Text = sUa(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни українських букв на англійські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з російських на англійські
Sub convertUaToEng()
Dim i As Integer
Dim sLat As Variant
Dim sUa As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв, які потрібно міняти (sUa - це українські символи, які потрібно міняти. sLat - це англійські символи, які потрібно підставити замість українських)
sUa = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ї", "ф", "і", "в", "а", "п", "р", "о", "л", "д", "ж", "є", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", "'", "№", ";", "?", "Б", "Ю", ",", _
              "Й", "Ц", "У", "К", "Е", "Н", "Г", "Ш", "Щ", "З", "Х", "Ї", "Ф", "І", "В", "А", "П", "Р", "О", "Л", "Д", "Ж", "Є", "Я", "Ч", "С", "М", "И", "Т", "Ь", "?", Chr(34))
sLat = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "`", "#", "$", "&", "<", ">", "?", _
              "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", Chr(34), "Z", "X", "C", "V", "B", "N", "M", "~", "@")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'замінюємо всі українські символи на відповідні англійські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sUa) To UBound(sLat)
      .Text = sUa(i)
      .Replacement.Text = sLat(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub

Макрос заміни українських букв на російські у виділеному фрагменті тексту

'Конвертація виділених символів у тексті з українських на російські
Sub convertUaToRu()
Dim i As Integer
Dim sUa As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = Selection.Range
'Список букв, які потрібно міняти (sUa - це українські символи, які потрібно міняти. sRus - це російські символи, які підставляються замість українських)
sUa = Array("'", "ї", "і", "є", "?", "Ї", "І", "Є")
sRus = Array("ё", "ъ", "ы", "э", "Ё", "Ъ", "Ы", "Э")
Application.ScreenUpdating = False 'Забороняємо оновлення екрана під час роботи макросу
With rDoc.Find
'замінюємо всі українські символи на відповідні російські
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sUa) To UBound(sRus)
      .Text = sUa(i)
      .Replacement.Text = sRus(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True 'Оновлюємо екран
End Sub