Консультации Портала - Консультация #180670

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 180670

10.11.2010, 14:48

100.00 руб.

0 4 1

Компьютеры Программирование

Мне нужен Макрос для MS Word 2008.

Итак вот что мне нужно.

Если я ввел в Word`е слово ublhj'ktrnhjcnfywbz то выделив и нажав (выполнить макрос) это слово должно превратиться в гидроэлектростанция и наоборот.

Т.е макрос должен заменять английские буквы (и символы) на русские (в выделенном фрагменте) и наоборот.

Определение (на каком языке написан фрагмент) происходит очень просто
если в выделенном фрагменте 1-й символ один из этих йцукенгшщзхъфывапролджэячсмитьбю то язык русский и его надо менять на английский
если один из этих qwertyuiopasdfghjklzxcvbnm то язык англ и надо менять на рус
если ни то и ни другое то смотрим 2-й символ и т. д.

Ну соответственно длинна выделенного фрагмента может быть любой(любое слово,фраза,предложение).
Пробелы должны сохраняться! (между словами) (символами)

макрос должен заменять следующие символы

й на q
Й на Q
ц на w
ц на W
у на e
У на E
к на r
К на R

и так далее все буквы

теперь внимательно

х на [
Х на {
ъ на ]
Ъ на }
ж на ;
Ж на :
э на '
Э на "
б на ,
Б на <
ю на .
Ю на >
. на /
, на ?

Повторюсь еще раз.
Определяем раскладку (язык) и меняем на другой. (так как описано выше)

P.S. Макрос должен работать на Windows 7 в MS Word 2007
P.P.S. Вроде в логике программы нигде не ошибся.

Обсуждение

Неизвестный

10.11.2010, 16:56

общий

Хорошо бы если б сегодня уже было готово.

Неизвестный

11.11.2010, 01:57

общий

это ответ

Здравствуйте, Иванов Евгений Витальевич!
Определяет язык не по входящим символам, можно сделать и по вашему алгоритму.
Написан в Word 2003, отработает и в 2007 офисе.

Приложение:
Sub Translit()

Dim rus(1 To 66) As Long 'массив для русских символов
Dim eng(1 To 66) As Long 'английские
' "'
en = "F<DULT:PBQRKVYJGHCNEA{WXIO}SM0>Zf,dult;pbqrkvyjghcnea[wxio]sm0.z"

For i = 1 To 64 'забиваем массив
rus(i) = i + 191 'русские символы от 192 до 255
eng(i) = Asc(Mid(en, i, 1)) 'английские
Next i
eng(30) = 34 ' кавычки
eng(62) = 39 ' апостроф
eng(65) = 47 ' /
eng(66) = 63 ' ?
rus(65) = 46 ' точка
rus(66) = 44 ' запятая

s = Selection.Text
b = IIf(Selection.LanguageID = wdRussian, True, False)
n = Len(s)
For j = 1 To n
t = False
For i = 1 To 66
If Asc(Mid(s, j, 1)) = IIf(b, rus(i), eng(i)) Then
ss = ss & Chr(IIf(Not b, rus(i), eng(i)))
t = True
End If
Next
If Not t Then ss = ss & Mid(s, j, 1)
Next j
Selection.Text = ss
Selection.LanguageID = IIf(b, wdEnglishUS, wdRussian)
End Sub

Неизвестный

11.11.2010, 17:02

общий

Не работает буква Э (если можно так выразиться)

То есть если написать английской раскладкой "[j '[j и выполнить макрос то вместо Эхо эхо мы получаем “хо ‘хо.
Больше (вроде) недочетов не заметил.

А в остальном отлично! Довольно кратко.

Исправьте пожалуйста букву Э

и напишите к каждой строчке комментарий (поподробней).
Просто с Бэйсиком совсем не знаком а преподу как то объяснять надо))

Неизвестный

12.11.2010, 00:31

общий

Насчет кавычек и апострофа, есть quotation mark - ", left double quotation mark - “ то же про апостроф, нужно всего лишь добавить их коды в массив. Был бы рад услышать комментарий препода))

Код:


Sub Translit()
Const m As Integer = 70
Dim rus(1 To m) As Long      ' массив для символов кириллицы
Dim eng(1 To m) As Long     ' массив для символов латиницы
' строка для латиницы, соответствующая по индексу массива кириллице, за исключением кавычек и апострофа
en = "F<DULT:PBQRKVYJGHCNEA{WXIO}SM0>Zf,dult;pbqrkvyjghcnea[wxio]sm0.z"

For i = 1 To 64                       ' забиваем массив символами кириллицы, точнее кодами соответствующими им
    rus(i) = i + 191                  ' символы от 192 до 255
    eng(i) = Asc(Mid(en, i, 1))  ' символами латиницы
Next i

eng(30) = 34    ' перезаписываем на код кавычек
eng(62) = 39    ' перезаписываем на код апострофа
eng(65) = 47    ' добавляем код /
eng(66) = 63    ' ?
For i = 1 To 4
    eng(i + 66) = i + 144
Next i
rus(65) = 46    ' точка
rus(66) = 44    ' запятая
rus(67) = 253
rus(68) = 253
rus(69) = 221
rus(70) = 221
s = Selection.Text                                                                 ' выделенный текст
b = IIf(Selection.LanguageID = wdRussian, True, False)      ' проверка на язык выделенного текста, если русский то true
n = Len(s)                                                                             ' длина выделенного текста
' цикл по всем символам выделенного текста
For j = 1 To n
    t = False
    For i = 1 To m                                                                   ' цикл по массиву
        If Asc(Mid(s, j, 1)) = IIf(b, rus(i), eng(i)) Then               ' если код символа строки найден в соответствующем массиве то...
            ss = ss & Chr(IIf(Not b, rus(i), eng(i)))                     ' меняем
            t = True                                                                    ' булевая переменная для записи в строку символов, кода которых нет в массивах
        Exit For
        End If
    Next
    If Not t Then ss = ss & Mid(s, j, 1)                                    ' см. комментарий выше )
Next j
    Selection.Text = ss                                                           ' перезаписываем выделенный текст
    Selection.LanguageID = IIf(b, wdEnglishUS, wdRussian) ' меняем язык текста
End Sub

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.