Многие, а особенно - участники форумов, знают о баге работы буфера обмена в VISTA и Win-7: если скопировать в буфер обмена текст, содержащий символы кириллицы, не переключив перед копированием раскладку клавиатуры в RUS, то после вставки скопированного текста в ответ форума или "блокнот" вместо кириллических букв будут "кракозябры" типа: Äîïîëíèòåëüíûå ñâåäåíèÿ ñì. â çàìåòêàõ î âûïóñêå
Для того, чтобы прочесть "сглюченный" таким образом текст, разработана функция пользователя: [vba]
Код
Function ПОЧИНИТЬ_КИРИЛЛИЦУ(ГЛЮК$) '--------------------------------------------------------------------------------------- ' Procedure : ПОЧИНИТЬ_КИРИЛЛИЦУ ' Author : The_Prist & Alex_ST ' DateTime : 29.04.11, 09:52 ' Topic_HEADER : Как прочесть "кракозябры", получаемые после копирования-вставки кириллицы из Висты? ' Topic_URL : http://www.planetaexcel.ru/forum.php?thread_id=26894 ' Purpose : правит глюки типа Ýòà äîë и другие "кракозябры" после вставки кириллицы из Vista ' Notes : '--------------------------------------------------------------------------------------- Dim Arr, i%, sTxt$, sSymb$ 'ГЛЮК = Replace(ГЛЮК, "", ";"): ГЛЮК = Replace(ГЛЮК, ";;", ";"):Arr = Split(ГЛЮК, ";") Arr = Split(Replace(Replace(ГЛЮК, "", ";"), ";;", ";"), ";") If UBound(Arr) > LBound(Arr) Then For i = LBound(Arr) To UBound(Arr) If Left(Arr(i), 2) = "" And IsNumeric(Mid(Arr(i), 3)) Then Arr(i) = CInt(Replace(Arr(i), "", "")) Arr(i) = Chr(IIf(Arr(i) > 256, Arr(i) - 848, Arr(i))) End If Next sTxt = Join(Arr, "") Else For i = 1 To Len(ГЛЮК) sSymb = Mid(ГЛЮК, i, 1) If AscW(sSymb) > 255 Then sTxt = sTxt & sSymb Else sTxt = sTxt & Chr(AscW(sSymb)) End If Next i End If ПОЧИНИТЬ_КИРИЛЛИЦУ = sTxt End Function
[/vba]
А для того, чтобы такие глюки не возникали при вашей работе, KukLP где-то нарыл следующий метод: 1. В папке system32удаляем файлc_1252.nls 2. Там же делаем копию файлаc_1251.nls и переименовываем её вc_1252.nls 3. Перезагружаемся. Главная проблема - суметь удалить имеющийся файл c_1252.nls Виста, маниакальная сволочь , не даёт это сделать даже администратору. А стать Full Admin я не сумел. Зато по совету того же KukLP я попробовал удалить файл с помощью программы Unlocker - получилось!
Многие, а особенно - участники форумов, знают о баге работы буфера обмена в VISTA и Win-7: если скопировать в буфер обмена текст, содержащий символы кириллицы, не переключив перед копированием раскладку клавиатуры в RUS, то после вставки скопированного текста в ответ форума или "блокнот" вместо кириллических букв будут "кракозябры" типа: Äîïîëíèòåëüíûå ñâåäåíèÿ ñì. â çàìåòêàõ î âûïóñêå
Для того, чтобы прочесть "сглюченный" таким образом текст, разработана функция пользователя: [vba]
Код
Function ПОЧИНИТЬ_КИРИЛЛИЦУ(ГЛЮК$) '--------------------------------------------------------------------------------------- ' Procedure : ПОЧИНИТЬ_КИРИЛЛИЦУ ' Author : The_Prist & Alex_ST ' DateTime : 29.04.11, 09:52 ' Topic_HEADER : Как прочесть "кракозябры", получаемые после копирования-вставки кириллицы из Висты? ' Topic_URL : http://www.planetaexcel.ru/forum.php?thread_id=26894 ' Purpose : правит глюки типа Ýòà äîë и другие "кракозябры" после вставки кириллицы из Vista ' Notes : '--------------------------------------------------------------------------------------- Dim Arr, i%, sTxt$, sSymb$ 'ГЛЮК = Replace(ГЛЮК, "", ";"): ГЛЮК = Replace(ГЛЮК, ";;", ";"):Arr = Split(ГЛЮК, ";") Arr = Split(Replace(Replace(ГЛЮК, "", ";"), ";;", ";"), ";") If UBound(Arr) > LBound(Arr) Then For i = LBound(Arr) To UBound(Arr) If Left(Arr(i), 2) = "" And IsNumeric(Mid(Arr(i), 3)) Then Arr(i) = CInt(Replace(Arr(i), "", "")) Arr(i) = Chr(IIf(Arr(i) > 256, Arr(i) - 848, Arr(i))) End If Next sTxt = Join(Arr, "") Else For i = 1 To Len(ГЛЮК) sSymb = Mid(ГЛЮК, i, 1) If AscW(sSymb) > 255 Then sTxt = sTxt & sSymb Else sTxt = sTxt & Chr(AscW(sSymb)) End If Next i End If ПОЧИНИТЬ_КИРИЛЛИЦУ = sTxt End Function
[/vba]
А для того, чтобы такие глюки не возникали при вашей работе, KukLP где-то нарыл следующий метод: 1. В папке system32удаляем файлc_1252.nls 2. Там же делаем копию файлаc_1251.nls и переименовываем её вc_1252.nls 3. Перезагружаемся. Главная проблема - суметь удалить имеющийся файл c_1252.nls Виста, маниакальная сволочь , не даёт это сделать даже администратору. А стать Full Admin я не сумел. Зато по совету того же KukLP я попробовал удалить файл с помощью программы Unlocker - получилось!Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 06.06.2011, 12:24
А ещё можно прямо на рабочем столе создать файл скрипта VBA (обычный текстовой файл с расширением .vbs), содержащий такой код: [vba]
Код
'берет текст из буфера обмена и выводит сообщение с исправленным текстом Dim GLUK, Arr, i, sTxt, sSymb With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard: GLUK = .GetText ' получить значение из буфера обмена End With Arr = Split(Replace(Replace(GLUK, "", ";"), ";;", ";"), ";") If UBound(Arr) > LBound(Arr) Then For i = LBound(Arr) To UBound(Arr) If Left(Arr(i), 2) = "" And IsNumeric(Mid(Arr(i), 3)) Then Arr(i) = CInt(Replace(Arr(i), "", "")) If Arr(i) > 256 Then Arr(i) = Arr(i) - 848 Arr(i) = Chr(Arr(i)) End If Next sTxt = Join(Arr, "") Else For i = 1 To Len(GLUK) sSymb = Mid(GLUK, i, 1) If AscW(sSymb) > 255 Then sTxt = sTxt & sSymb Else sTxt = sTxt & Chr(AscW(sSymb)) End If Next End If GLUK = InputBox("", "", sTxt)
[/vba] тогда будет достаточно скопировать искалеченный текст в буфер обмена и два раза кликнуть по этому скрипту. Скрипт выведет InputBox с раскодированным текстом. В приложенном примере переименуйте файл KRAROZYABER.VBS.txt в KRAROZYABER.VBS Образцы искалеченных текстов для проверки скрипта и UDF - в .xls-файле
А ещё можно прямо на рабочем столе создать файл скрипта VBA (обычный текстовой файл с расширением .vbs), содержащий такой код: [vba]
Код
'берет текст из буфера обмена и выводит сообщение с исправленным текстом Dim GLUK, Arr, i, sTxt, sSymb With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard: GLUK = .GetText ' получить значение из буфера обмена End With Arr = Split(Replace(Replace(GLUK, "", ";"), ";;", ";"), ";") If UBound(Arr) > LBound(Arr) Then For i = LBound(Arr) To UBound(Arr) If Left(Arr(i), 2) = "" And IsNumeric(Mid(Arr(i), 3)) Then Arr(i) = CInt(Replace(Arr(i), "", "")) If Arr(i) > 256 Then Arr(i) = Arr(i) - 848 Arr(i) = Chr(Arr(i)) End If Next sTxt = Join(Arr, "") Else For i = 1 To Len(GLUK) sSymb = Mid(GLUK, i, 1) If AscW(sSymb) > 255 Then sTxt = sTxt & sSymb Else sTxt = sTxt & Chr(AscW(sSymb)) End If Next End If GLUK = InputBox("", "", sTxt)
[/vba] тогда будет достаточно скопировать искалеченный текст в буфер обмена и два раза кликнуть по этому скрипту. Скрипт выведет InputBox с раскодированным текстом. В приложенном примере переименуйте файл KRAROZYABER.VBS.txt в KRAROZYABER.VBS Образцы искалеченных текстов для проверки скрипта и UDF - в .xls-файлеAlex_ST
Блин! Эти микро-мягкие совсем мышей не ловят! На работе поставил комп С ЛИЦЕНЗИОННОЙ Win7 Pro - те же проблемы с кракозябрами вместо кириллицы, что и появились с выходим Висты! И тем же способом только и решаются
Quote (Alex_ST)
1. В папке system32 удаляем файл c_1252.nls 2. Там же делаем копию файла c_1251.nls и переименовываем её в c_1252.nls 3. Перезагружаемся.
Блин! Эти микро-мягкие совсем мышей не ловят! На работе поставил комп С ЛИЦЕНЗИОННОЙ Win7 Pro - те же проблемы с кракозябрами вместо кириллицы, что и появились с выходим Висты! И тем же способом только и решаются
Quote (Alex_ST)
1. В папке system32 удаляем файл c_1252.nls 2. Там же делаем копию файла c_1251.nls и переименовываем её в c_1252.nls 3. Перезагружаемся.
если скопировать в буфер обмена текст, содержащий символы кириллицы, не переключив перед копированием раскладку клавиатуры в RUS, то после вставки скопированного текста в ответ форума или "блокнот" вместо кириллических букв будут "кракозябры"
Извини, Алекс. При всем уважении, все мои попытки получить кракозябры, следуя твоим инструкциям, потерпели фиаско. Из буфера обмена упорно изымаются для вставки буквы в кирилице: проии мтттмтт лывлддла аиалдд дав дылвадлдлащ или мне для этого понятные слова писать нужно было )))
Quote (Alex_ST)
если скопировать в буфер обмена текст, содержащий символы кириллицы, не переключив перед копированием раскладку клавиатуры в RUS, то после вставки скопированного текста в ответ форума или "блокнот" вместо кириллических букв будут "кракозябры"
Извини, Алекс. При всем уважении, все мои попытки получить кракозябры, следуя твоим инструкциям, потерпели фиаско. Из буфера обмена упорно изымаются для вставки буквы в кирилице: проии мтттмтт лывлддла аиалдд дав дылвадлдлащ или мне для этого понятные слова писать нужно было )))light26
все мои попытки получить кракозябры, следуя твоим инструкциям, потерпели фиаско
Вадим, вообще-то в топике обсуждался вопрос не как получить кракозябры, а как от них избавиться Ну, а уж если они тебе зачем-то нужны, то это явно не сюда
Александр, для меня, к счастью, борьба с глюками вставки кириллицы на всех компах с Vista и Win7 закончилась моей полной победой после замены c_1252.nls на c_1251.nls. При этом никакие ухищрения с реестром не помогали. А этот метод - с пол-пинка! Поэтому натурный эксперимент поставить не могу. Твой код, естественно, намного короче. И я нечто подобное, кажется, пробовал на начальных этапах борьбы. Но потом выяснилось, что существует ещё несколько разновидностей сглючивания кириллицы. И просто приведённый мною код лечит несколько разных типов встречающихся "зюклвок" вместо буковок: и настоящие "кракозябры" типа "Äîïîëíèòåëüíûå" , и наборы символов, начинающиеся на "", и что-то там ещё (я уже не помню, всё это обсуждалось на Планете в топике, на который я давал ссылку в комментариях к старт-топику.
Quote (light26)
все мои попытки получить кракозябры, следуя твоим инструкциям, потерпели фиаско
Вадим, вообще-то в топике обсуждался вопрос не как получить кракозябры, а как от них избавиться Ну, а уж если они тебе зачем-то нужны, то это явно не сюда
Александр, для меня, к счастью, борьба с глюками вставки кириллицы на всех компах с Vista и Win7 закончилась моей полной победой после замены c_1252.nls на c_1251.nls. При этом никакие ухищрения с реестром не помогали. А этот метод - с пол-пинка! Поэтому натурный эксперимент поставить не могу. Твой код, естественно, намного короче. И я нечто подобное, кажется, пробовал на начальных этапах борьбы. Но потом выяснилось, что существует ещё несколько разновидностей сглючивания кириллицы. И просто приведённый мною код лечит несколько разных типов встречающихся "зюклвок" вместо буковок: и настоящие "кракозябры" типа "Äîïîëíèòåëüíûå" , и наборы символов, начинающиеся на "", и что-то там ещё (я уже не помню, всё это обсуждалось на Планете в топике, на который я давал ссылку в комментариях к старт-топику.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 05.12.2011, 15:04
Предлагаю в первом посте все, что после кода сделать крупным и красным ! Ведь знал, что это здесь, а проглядел! Увидел после 3-х кратного скрола темы... (залезал на всякий случай, хуже не будет, вдруг чего забыл) Не знаю, насколько нать все коды, а это действенная вещь! (WINDOWS 7)
Предлагаю в первом посте все, что после кода сделать крупным и красным ! Ведь знал, что это здесь, а проглядел! Увидел после 3-х кратного скрола темы... (залезал на всякий случай, хуже не будет, вдруг чего забыл) Не знаю, насколько нать все коды, а это действенная вещь! (WINDOWS 7)RAN
Очень хорошая вещь придумана, удалил, скопировал, переименовал. Все получилось. В Win7 кстати этот глюк исправился и в VB6.5. Долго мучился, ничего не помогало. Теперь все работает. Огромное спасибо.
Очень хорошая вещь придумана, удалил, скопировал, переименовал. Все получилось. В Win7 кстати этот глюк исправился и в VB6.5. Долго мучился, ничего не помогало. Теперь все работает. Огромное спасибо. Chieskela
Юзайте, получайте удовольствие А главное спасибо Серёге-KukLP, который это наковырял и поделился на Планете, но там топик "утонул" и забылся. А я у себя в "заначке" сохранил и здесь с народом поделился.
Quote (Chieskela)
Теперь все работает. Огромное спасибо.
Юзайте, получайте удовольствие А главное спасибо Серёге-KukLP, который это наковырял и поделился на Планете, но там топик "утонул" и забылся. А я у себя в "заначке" сохранил и здесь с народом поделился.Alex_ST
Ну, если вам не трудно запомнить, что перед каждым копированием нужно переключаться в РУС, то кто же будет спорить? ИМХО, намного проще один раз починить и навсегда забыть о раскладке.
Ну, если вам не трудно запомнить, что перед каждым копированием нужно переключаться в РУС, то кто же будет спорить? ИМХО, намного проще один раз починить и навсегда забыть о раскладке.Alex_ST
Ещё раз убедился в действенности метода с заменой c_1252.nls на c_1251.nls , описанной красным в первом посте. После капитальной чисткой компа и всего вообще с помощью RegUtility 4, нашедшей кучу ошибок, вдруг появились давно забытые звери - кракозябры. Нашёл свой пост. Заменил c_1252.nls на c_1251.nls. Перегрузился. СУПЕР! Спасибо Серёге-KukLP, нарывшему этот метод и мне, выложившему его здесь!
Ещё раз убедился в действенности метода с заменой c_1252.nls на c_1251.nls , описанной красным в первом посте. После капитальной чисткой компа и всего вообще с помощью RegUtility 4, нашедшей кучу ошибок, вдруг появились давно забытые звери - кракозябры. Нашёл свой пост. Заменил c_1252.nls на c_1251.nls. Перегрузился. СУПЕР! Спасибо Серёге-KukLP, нарывшему этот метод и мне, выложившему его здесь! Alex_ST
Сделал своё решение, максимально простое, для экспресс перевода самых частых кракозябр. Просто положу его здесь для сравнения и ассортимента.
[vba]
Код
Function TranLet$(StrX$) ' Roman Rioran Voronov, 21.07.2015, voronov_rv@mail.ru ' Переводит кракозябры с кракозябрского на русский Dim ArrX() As Byte, i&, LenX&, Symbol As Byte ArrX = StrX LenX = Len(StrX) For i = 1 To LenX If ArrX(i * 2 - 1) = 0 Then Symbol = ArrX(i * 2 - 2) Select Case Symbol Case 192 To 255, 168, 184 TranLet = TranLet & Chr(Symbol) Case Else TranLet = TranLet & Mid(StrX, i, 1) End Select Else TranLet = TranLet & Mid(StrX, i, 1) End If Next i End Function
[/vba]
Всем привет =)
Сделал своё решение, максимально простое, для экспресс перевода самых частых кракозябр. Просто положу его здесь для сравнения и ассортимента.
[vba]
Код
Function TranLet$(StrX$) ' Roman Rioran Voronov, 21.07.2015, voronov_rv@mail.ru ' Переводит кракозябры с кракозябрского на русский Dim ArrX() As Byte, i&, LenX&, Symbol As Byte ArrX = StrX LenX = Len(StrX) For i = 1 To LenX If ArrX(i * 2 - 1) = 0 Then Symbol = ArrX(i * 2 - 2) Select Case Symbol Case 192 To 255, 168, 184 TranLet = TranLet & Chr(Symbol) Case Else TranLet = TranLet & Mid(StrX, i, 1) End Select Else TranLet = TranLet & Mid(StrX, i, 1) End If Next i End Function