прохожий2019
Дата: Среда, 21.04.2021, 19:07 |
Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1398
Репутация:
364
±
Замечаний:
0% ±
365 Beta Channel
Sub changeLang() 'переключение с английской раскладки на русскую и наоборот
Dim i%, j%, str1$, str2$, strout$
Dim rng As Range, cell As Range
Dim da As Boolean
Dim Rus As Variant
Rus = Array ("а" , "б" , "в" , "г" , "д" , "е" , "ё" , "ж" , "з" , "и" , "й" , "к" , _
"л" , "м" , "н" , "о" , "п" , "р" , "с" , "т" , "у" , "ф" , "х" , "ц" , "ч" , "ш" , _
"щ" , "ъ" , "ы" , "ь" , "э" , "ю" , "я" , "А" , "Б" , "В" , "Г" , "Д" , "Е" , "Ё" , _
"Ж" , "З" , "И" , "Й" , "К" , "Л" , "М" , "Н" , "О" , "П" , "Р" , "С" , "Т" , "У" , _
"Ф" , "Х" , "Ц" , "Ч" , "Ш" , "Щ" , "Ъ" , "Ы" , "Ь" , "Э" , "Ю" , "Я" , "." , "," , _
"?" , ":" , ";" , "№" , "" "" , "f" , "," , "d" , "u" , "l" , "t" , "`" , ";" , "p" , _
"b" , "q" , "r" , "k" , "v" , "y" , "j" , "g" , "h" , "c" , "n" , "e" , "a" , "[" , _
"w" , "x" , "i" , "o" , "]" , "s" , "m" , "'" , "." , "z" , "F" , "<" , "D" , "U" , _
"L" , "T" , "~" , ":" , "P" , "B" , "Q" , "R" , "K" , "V" , "Y" , "J" , "G" , "H" , _
"C" , "N" , "E" , "A" , "{" , "W" , "X" , "I" , "O" , "}" , "S" , "M" , "" "" , ">" , _
"Z" , "/" , "?" , "&" , "^" , "$" , "#" , "@" )
Dim Eng As Variant
Eng = Array ("f" , "," , "d" , "u" , "l" , "t" , "`" , ";" , "p" , "b" , "q" , "r" , _
"k" , "v" , "y" , "j" , "g" , "h" , "c" , "n" , "e" , "a" , "[" , "w" , "x" , "i" , _
"o" , "]" , "s" , "m" , "'" , "." , "z" , "F" , "<" , "D" , "U" , "L" , "T" , "~" , _
":" , "P" , "B" , "Q" , "R" , "K" , "V" , "Y" , "J" , "G" , "H" , "C" , "N" , "E" , _
"A" , "{" , "W" , "X" , "I" , "O" , "}" , "S" , "M" , "" "" , ">" , "Z" , "/" , "?" , _
"&" , "^" , "$" , "#" , "@" , "а" , "б" , "в" , "г" , "д" , "е" , "ё" , "ж" , "з" , _
"и" , "й" , "к" , "л" , "м" , "н" , "о" , "п" , "р" , "с" , "т" , "у" , "ф" , "х" , _
"ц" , "ч" , "ш" , "щ" , "ъ" , "ы" , "ь" , "э" , "ю" , "я" , "А" , "Б" , "В" , "Г" , _
"Д" , "Е" , "Ё" , "Ж" , "З" , "И" , "Й" , "К" , "Л" , "М" , "Н" , "О" , "П" , "Р" , _
"С" , "Т" , "У" , "Ф" , "Х" , "Ц" , "Ч" , "Ш" , "Щ" , "Ъ" , "Ы" , "Ь" , "Э" , "Ю" , _
"Я" , "." , "," , "?" , ":" , ";" , "№" , "" "" )
On Error Resume Next
If Selection.Cells.Count > 1 And Not ActiveCell.MergeCells Then
Set rng = Selection.SpecialCells(xlCellTypeConstants)
Else
Set rng = Selection
End If
On Error GoTo 0
For Each cell In rng
If (Not IsEmpty (cell)) And (Not IsError (cell)) Then
strout = ""
For i = 1 To Len (cell)
str1 = Mid (cell, i, 1 )
da = False
For j = 0 To 144
If Eng(j) = str1 Then
str2 = Rus(j)
da = True
Exit For
End If
Next j
If da Then strout = strout & str2 Else strout = strout & _
str1
Next i
cell.Value = strout
End If
Next cell
End Sub
Sub changeLang() 'переключение с английской раскладки на русскую и наоборот
Dim i%, j%, str1$, str2$, strout$
Dim rng As Range, cell As Range
Dim da As Boolean
Dim Rus As Variant
Rus = Array ("а" , "б" , "в" , "г" , "д" , "е" , "ё" , "ж" , "з" , "и" , "й" , "к" , _
"л" , "м" , "н" , "о" , "п" , "р" , "с" , "т" , "у" , "ф" , "х" , "ц" , "ч" , "ш" , _
"щ" , "ъ" , "ы" , "ь" , "э" , "ю" , "я" , "А" , "Б" , "В" , "Г" , "Д" , "Е" , "Ё" , _
"Ж" , "З" , "И" , "Й" , "К" , "Л" , "М" , "Н" , "О" , "П" , "Р" , "С" , "Т" , "У" , _
"Ф" , "Х" , "Ц" , "Ч" , "Ш" , "Щ" , "Ъ" , "Ы" , "Ь" , "Э" , "Ю" , "Я" , "." , "," , _
"?" , ":" , ";" , "№" , "" "" , "f" , "," , "d" , "u" , "l" , "t" , "`" , ";" , "p" , _
"b" , "q" , "r" , "k" , "v" , "y" , "j" , "g" , "h" , "c" , "n" , "e" , "a" , "[" , _
"w" , "x" , "i" , "o" , "]" , "s" , "m" , "'" , "." , "z" , "F" , "<" , "D" , "U" , _
"L" , "T" , "~" , ":" , "P" , "B" , "Q" , "R" , "K" , "V" , "Y" , "J" , "G" , "H" , _
"C" , "N" , "E" , "A" , "{" , "W" , "X" , "I" , "O" , "}" , "S" , "M" , "" "" , ">" , _
"Z" , "/" , "?" , "&" , "^" , "$" , "#" , "@" )
Dim Eng As Variant
Eng = Array ("f" , "," , "d" , "u" , "l" , "t" , "`" , ";" , "p" , "b" , "q" , "r" , _
"k" , "v" , "y" , "j" , "g" , "h" , "c" , "n" , "e" , "a" , "[" , "w" , "x" , "i" , _
"o" , "]" , "s" , "m" , "'" , "." , "z" , "F" , "<" , "D" , "U" , "L" , "T" , "~" , _
":" , "P" , "B" , "Q" , "R" , "K" , "V" , "Y" , "J" , "G" , "H" , "C" , "N" , "E" , _
"A" , "{" , "W" , "X" , "I" , "O" , "}" , "S" , "M" , "" "" , ">" , "Z" , "/" , "?" , _
"&" , "^" , "$" , "#" , "@" , "а" , "б" , "в" , "г" , "д" , "е" , "ё" , "ж" , "з" , _
"и" , "й" , "к" , "л" , "м" , "н" , "о" , "п" , "р" , "с" , "т" , "у" , "ф" , "х" , _
"ц" , "ч" , "ш" , "щ" , "ъ" , "ы" , "ь" , "э" , "ю" , "я" , "А" , "Б" , "В" , "Г" , _
"Д" , "Е" , "Ё" , "Ж" , "З" , "И" , "Й" , "К" , "Л" , "М" , "Н" , "О" , "П" , "Р" , _
"С" , "Т" , "У" , "Ф" , "Х" , "Ц" , "Ч" , "Ш" , "Щ" , "Ъ" , "Ы" , "Ь" , "Э" , "Ю" , _
"Я" , "." , "," , "?" , ":" , ";" , "№" , "" "" )
On Error Resume Next
If Selection.Cells.Count > 1 And Not ActiveCell.MergeCells Then
Set rng = Selection.SpecialCells(xlCellTypeConstants)
Else
Set rng = Selection
End If
On Error GoTo 0
For Each cell In rng
If (Not IsEmpty (cell)) And (Not IsError (cell)) Then
strout = ""
For i = 1 To Len (cell)
str1 = Mid (cell, i, 1 )
da = False
For j = 0 To 144
If Eng(j) = str1 Then
str2 = Rus(j)
da = True
Exit For
End If
Next j
If da Then strout = strout & str2 Else strout = strout & _
str1
Next i
cell.Value = strout
End If
Next cell
End Sub
прохожий2019
Ответить
Сообщение
[vba]
Sub changeLang() 'переключение с английской раскладки на русскую и наоборот Dim i %; j %; str1 $; str2 $; strout $ Dim rng As Range ; cell As Range Dim da As Boolean Dim Rus As Variant Rus = Array("а"; "б"; "в"; "г"; "д"; "е"; "ё"; "ж"; "з"; "и"; "й"; "к"; _ "л"; "м"; "н"; "о"; "п"; "р"; "с"; "т"; "у"; "ф"; "х"; "ц"; "ч"; "ш"; _ "щ"; "ъ"; "ы"; "ь"; "э"; "ю"; "я"; "А"; "Б"; "В"; "Г"; "Д"; "Е"; "Ё"; _ "Ж"; "З"; "И"; "Й"; "К"; "Л"; "М"; "Н"; "О"; "П"; "Р"; "С"; "Т"; "У"; _ "Ф"; "Х"; "Ц"; "Ч"; "Ш"; "Щ"; "Ъ"; "Ы"; "Ь"; "Э"; "Ю"; "Я"; "."; ","; _ "?"; ":"; ";"; "№"; """"; "f"; ","; "d"; "u"; "l"; "t"; "`"; ";"; "p"; _ "b"; "q"; "r"; "k"; "v"; "y"; "j"; "g"; "h"; "c"; "n"; "e"; "a"; "["; _ "w"; "x"; "i"; "o"; "]"; "s"; "m"; "'"; "."; "z"; "F"; "<"; "D"; "U"; _ "L"; "Т"; "~"; ":"; "P"; "B"; "Q"; "R"; "K"; "V"; "Y"; "J"; "G"; "H"; _ "C"; "Ч"; "E"; "A"; "{"; "W"; "X"; "I"; "O"; "}"; "S"; "M"; """"; ">"; _ "Z"; "/"; "?"; "&"; "^"; "$"; "#"; "@") Dim Eng As Variant Eng = Array("f"; ","; "d"; "u"; "l"; "t"; "`"; ";"; "p"; "b"; "q"; "r"; _ "k"; "v"; "y"; "j"; "g"; "h"; "c"; "n"; "e"; "a"; "["; "w"; "x"; "i"; _ "o"; "]"; "s"; "m"; "'"; "."; "z"; "F"; "<"; "D"; "U"; "L"; "Т"; "~"; _ ":"; "P"; "B"; "Q"; "R"; "K"; "V"; "Y"; "J"; "G"; "H"; "C"; "Ч"; "E"; _ "A"; "{"; "W"; "X"; "I"; "O"; "}"; "S"; "M"; """"; ">"; "Z"; "/"; "?"; _ "&"; "^"; "$"; "#"; "@"; "а"; "б"; "в"; "г"; "д"; "е"; "ё"; "ж"; "з"; _ "и"; "й"; "к"; "л"; "м"; "н"; "о"; "п"; "р"; "с"; "т"; "у"; "ф"; "х"; _ "ц"; "ч"; "ш"; "щ"; "ъ"; "ы"; "ь"; "э"; "ю"; "я"; "А"; "Б"; "В"; "Г"; _ "Д"; "Е"; "Ё"; "Ж"; "З"; "И"; "Й"; "К"; "Л"; "М"; "Н"; "О"; "П"; "Р"; _ "С"; "Т"; "У"; "Ф"; "Х"; "Ц"; "Ч"; "Ш"; "Щ"; "Ъ"; "Ы"; "Ь"; "Э"; "Ю"; _ "Я"; "."; ","; "?"; ":"; ";"; "№"; """") On Error Resume Next If Selection.Cells.Count > 1 And Not ActiveCell.MergeCells Then Set rng = Selection.SpecialCells(xlCellTypeConstants ) Else Set rng = Selection End If On Error GoTo 0 For Each cell In rng If (Not IsEmpty(cell )) And (Not IsError(cell )) Then strout = "" For i = 1 To Len(cell ) str1 = Mid(cell ; i ; 1) da = False For j = 0 To 144 If Eng(j ) = str1 Then str2 = Rus(j ) da = Тrue Exit For End If Next j If da Then strout = strout & str2 Else strout = strout & _ str1 Next i cell.Value = strout End If Next cellEnd Sub
[/vba]
Автор - прохожий2019 Дата добавления - 21.04.2021 в 19:07