1

Тема: Замена CP1252 -> CP1251 на кириллические буквы

В некоторых случаях при копировании текстового кириллического слоя из файла PDF в Word образуются кракозябры следующего вида:

Ïðè ìаíèïóëÿöèÿõ ñ äåðåâüÿìè ÷àñòî âîçíèêàåò çàäà÷à ñîçäàíèè èõ êîïèé. Êàê è áîëüøèíñòâî äðóãèõ àëãîðèòìîâ àëãîðèòì êîïèðîâàíèÿ èìååò ðåêóðñèâíûõ õàðàêòåð. Îí íà÷èíàåò ðàáîòó ñ êîðíÿ è â ïåðâóþ î÷åðåäü ñòðîèò ëåâîå ïîääåðåâî óçëà, à çàòåì - ïðàâîå ïîääåðåâî. Òîëüêî ïîñëå ýòîãî ñîçäàåòñÿ íîâûé óçåë.

Декодер Артемия Лебедева (внешняя ссылка) распознает преобразование этого текста в кириллический, как CP1252 -> CP1251.

Следующий несложный макрос позволяет выполнить преобразование CP1252 -> CP1251 по всему тексту файла Word.

Sub changeToRus()
'
' Замена кракозябр на кириллические буквы
' CP1252 -> CP1251
'
    For i = 192 To 255
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Формирование запроса для поля Найти
        sRus = Array("А", "Б", "В", "Г", "Д", "Е", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", _
        "П", "Р", "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я", _
        "а", "б", "в", "г", "д", "е", "ж", "з", "и", "й", "к", "л", "м", "н", "о", _
        "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
        ' Формирование массива кириллических букв для поля Заменить
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = sRus(i - 192)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        ' Выполнение замены по тексту
    Next i
End Sub

Примечание. В процессе написания данного макроса я столкнулся со следующей проблемой. Поиск кракозябр, соответствующих кириллическим буквам А-я, осуществляется в режиме Учитывать регистр (.MatchCase = True) с помощью кодов ^u192-^u255. Поиск и замена кириллических букв А-Я осуществляется в режиме Учитывать регистр с помощью кодов ^128-^159, а букв а-п – с помощью кодов ^160-^175. Однако, символы с кодами ^176 и далее уже не соответствуют буквам р-я. Поэтому, по аналогии с решением http://wordexpert.ru/page/psevdokirilli … -kirillicu, пришлось вводить массив sRus, содержащий все кириллические буквы.
Буду признателен, если эксперты посоветуют мне, как выполнить поиск и замену букв р-я с помощью кодов типа ^nnn.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

2

Re: Замена CP1252 -> CP1251 на кириллические буквы

Коллега Вождь подсказал (http://wordexpert.ru/forum/viewtopic.php?id=1279), что в десятичном счислении кириллические буквы имеют коды ^u1040-^u1103.

Однако в поле "Заменить на" и в аналогичном месте в макросе параметры типа ^u0000 не принимаются.
В данной задаче же нужно рассчитать код в цикле. Поэтому оказалось очень полезным предложенное Вождем решение, которое VBA корректно принимает:
.Replacement.Text = ChrW(b1)
где b1 - это код символа в числовом формате.
Очень интересная встроенная функция ChrW, которая преобразует число в соответствующий символ Юникода!

Таким образом, можно будет обойтись без массива кириллических букв, и общий код макроса, решающего эту задачу, станет проще:

Sub changeToRus()
'
' Замена кракозябров на кириллические буквы
' CP1252 -> CP1251
'
    For i = 192 To 255
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Кракозябры - Codes ^u192-^u255
        b1 = i + 848
        ' Соответствующие кириллические буквы - Codes ^u1040-^u1103
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = ChrW(b1)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i
End Sub

Таблицу кодов Unicode для различных символов можно найти на сайте methodichka.ru (внешняя ссылка).
Там указываются шестнадцатеричный код и в скобках - десятеричный код символа.
Например:

&H410 (1040) - кириллическое А

Шестнадцатеричный код кириллического символа А равен &H410, а его десятеричный код - 1040.
Как мы уже отмечали для перевода числа в код Unicode используется встроенная функция ChrW.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3

Re: Замена CP1252 -> CP1251 на кириллические буквы

Почему-то у меня нормальный текст появляется в макросе, но в ворд он не копируется. Что делать то с вашим макросом

4

Re: Замена CP1252 -> CP1251 на кириллические буквы

maxim777 пишет:

Почему-то у меня нормальный текст появляется в макросе, но в ворд он не копируется. Что делать то с вашим макросом

Что вы имеете в виду: "текст появляется в макросе".
Опишите, пожалуйста, проблему поподробнее и выложите файл.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

5

Re: Замена CP1252 -> CP1251 на кириллические буквы

А как переделать этот макрос под эксель, чтобы так же поменять кодировку на всем листе?

6

Re: Замена CP1252 -> CP1251 на кириллические буквы

Макрос не обрабатывает букву "Ё". Можно ли его доработать?

7

Re: Замена CP1252 -> CP1251 на кириллические буквы

MCat78 пишет:

Макрос не обрабатывает букву "Ё". Можно ли его доработать?

По моим сведениям, Ё и ё в формате CP1252 отображаются так (прошу поправить меня, если символы другие):

¨¸

Тогда макрос преобразования форматов CP1252 -> CP1251 с учетом буквы Ё проще всего написать так:

Sub changeToRus()
'
' Замена кракозябр на кириллические буквы
' CP1252 -> CP1251
'
    For i = 192 To 255
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Формирование запроса для поля Найти
        sRus = Array("А", "Б", "В", "Г", "Д", "Е", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", _
        "П", "Р", "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я", _
        "а", "б", "в", "г", "д", "е", "ж", "з", "и", "й", "к", "л", "м", "н", "о", _
        "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
        ' Формирование массива кириллических букв для поля Заменить
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = sRus(i - 192)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        ' Выполнение замены по тексту
    Next i

        ' Замена Ё и ё
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(168)
        .Replacement.Text = "Ё"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(184)
        .Replacement.Text = "ё"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

То есть, в конце добавляется следующая часть:

' Замена Ё и ё
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(168)
        .Replacement.Text = "Ё"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(184)
        .Replacement.Text = "ё"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

8

Re: Замена CP1252 -> CP1251 на кириллические буквы

Новый текст для проверки перекодировки с учетом ё-фикации:

Ïðè ìàíèïóëÿöèÿõ ñ äåðåâüÿìè ÷àñòî âîçíèêàåò çàäà÷à ñîçäàíèè èõ êîïèé. Êàê è áîëüøèíñòâî äðóãèõ àëãîðèòìîâ àëãîðèòì êîïèðîâàíèÿ èìååò ðåêóðñèâíûõ õàðàêòåð. Îí íà÷èíàåò ðàáîòó ñ êîðíÿ è â ïåðâóþ î÷åðåäü ñòðîèò ëåâîå ïîääåðåâî óçëà, à çàòåì - ïðàâîå ïîääåðåâî. Òîëüêî ïîñëå ýòîãî ñîçäàåòñÿ íîâûé óçåë. ¨¸

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

9

Re: Замена CP1252 -> CP1251 на кириллические буквы

DrDen пишет:

А как переделать этот макрос под эксель, чтобы так же поменять кодировку на всем листе?

Основная проблема заключается в том, что Excel не воспринимает кодировку Юникод.
Поэтому при работе с Excel приходится использовать более сложные средства.
На сайте Excelvba.ru (внешняя ссылка) предложена универсальная функция ChangeTextCharset для перекодировки текстов в Excel из любой кодировки в любую другую.

Ниже мы адаптировали эту функцию для перекодировка всех ячеек выделенного диапазона из Windows-1252 в Windows-1251 (перед запуском макроса Перекодировка_1252_в_1251_ChangeTextCharset() необходимо выделить все ячейки, содержащие тексты только в кодировке  Windows-1252):

Sub Перекодировка_1252_в_1251_ChangeTextCharset()
    Dim ra As Range, cell As Range
    Set ra = Selection
    For Each cell In ra.Cells
        ИсходнаяСтрока = cell.Value
        ' вызываем функцию ChangeTextCharset с указанием кодировок
        ' (меняем кодировку с Windows-1252 на Windows-1251)
        ПерекодированнаяСтрока = ChangeTextCharset(ИсходнаяСтрока, "Windows-1251", "Windows-1252")
'        MsgBox "Результат перекодировки: """ & ПерекодированнаяСтрока & """", _
               vbInformation, "Перекодировка из Windows-1252 в Windows-1251"
        cell.Value = ПерекодированнаяСтрока
    Next cell
End Sub

Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, _
                           Optional ByVal SourceCharset$) As String
    ' функция перекодировки (смены кодировки) текстовой строки
   ' В качестве параметров функция получает текстовую строку txt$,
   ' и название кодировки DestCharset$ (в которую будет переведён текст)
   ' Функция возвращает текст в новой кодировке
   On Error Resume Next: Err.Clear
    With CreateObject("ADODB.Stream")
        .Type = 2: .Mode = 3
        If Len(SourceCharset$) Then .Charset = SourceCharset$    ' указываем исходную кодировку
       .Open
        .WriteText txt$
        .Position = 0
        .Charset = DestCharset$    ' назначаем новую кодировку
       ChangeTextCharset = .ReadText
        .Close
    End With
End Function

Данный макрос учитывает также ё-фикацию.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

10

Re: Замена CP1252 -> CP1251 на кириллические буквы

Вот еще пример корректно работающего кода
Выделить текст с кракозябрами и запустить макрос

Sub Corr1252_1251()
Dim s$, i&, j&
  s = Selection
  For i = 1 To Len(s)
    j = AscW(Mid$(s, i, 1))
    If j < 256 Then
        Mid$(s, i, 1) = Chr(j)
'       Debug.Print i & vbTab & Mid$(s, i, 1) & vbTab & j & vbTab & Chr(j)
    End If
  Next
  Selection.Text = s
End Sub

11

Re: Замена CP1252 -> CP1251 на кириллические буквы

Люди добрые, подскажите как в Visio как это реализовать?

12

Re: Замена CP1252 -> CP1251 на кириллические буквы

Komich пишет:

Люди добрые, подскажите как в Visio как это реализовать?

Боюсь, что по поводу Visio мы не сможем Вам помочь.
Попробуйте обратиться на специальный форум по Visio:
внешняя ссылка

Можете дать ссылку на наш макрос - может быть специалистам по Visio он чем-то поможет решить эту проблему.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.