[X6] Изменить кодировку текста

Тема в разделе «Автоматизация», создана пользователем avniv, 10 янв 2018.

    • Одобряю Одобряю x 1
  1. Не помню точно, пишу с холодильника
    ActiveDocument? ActiveLayer? 'hmmm'
     
  2. Макрос работает только ничего не изменяет!
     
  3. Таки
     
  4. ConvertRussianUnicode не работает?
     
  5. Это что?
     
  6. Sub TranslateText()

    Dim txts As ShapeRange
    Dim sh As Shape
    Set txts = ActivePage.FindShapes(Type:=cdrTextShape)
    For Each sh In txts
    'sh.Text.Story.LanguageID = 1033
    'sh.Text.Story.CharSet = 0
    ' s = ""
    ' t = OrigSelection.Item(1).Text.Story.Text
    ' For I = 1 To Len(t)
    ' B = Mid(t, I, 1) + Chr(0)
    ' a = AscW(StrConv(B, vbFromUnicode))
    ' s = s + ChrB(a And 255) + ChrB(0)

    ' Next I
    ' sh.Text.Story.Text = s
    sh.Text.Story.CharSet = cdrCharSetRussian
    sh.Text.Story.LanguageID = cdrRussian

    Next sh
    End Sub
    Так переделал, кодировку меняет, но корявые символы остаются. В ручную меняю все выходит. Почему?
     
  7. по ссылке @lev пример
    Код:
    Public Sub ConvertRussianUnicode()
    ' Description: Конвертирует ASCII текст в кириллицу UNICODE
    '
        Dim T As Text
        Dim s As Shape
        Dim d As Document
        Dim i As Integer, N As Integer
        Dim C As TextRange
        Set d = ActiveDocument
        'Устанавливаем начало группы для команды отмены
        d.BeginCommandGroup "Convert Russian Text To Unicode"
        'Перебираем все текстовые элементы текущей страницы
        For Each s In d.ActivePage.FindShapes(, cdrTextShape)   
            For Each C In s.Text.Story.Characters
                If C.CharSet <> cdrCharSetSymbol Then
                    N = AscW(C.WideText)
                    Select Case N
                    Case 165
                    C.WideText = ChrW$(1168): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ґ
                    Case 168
                    C.WideText = ChrW$(1025): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ё
                    Case 170
                    C.WideText = ChrW$(1028): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Є
                    Case 175
                    C.WideText = ChrW$(1031): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ї
                    Case 178
                    C.WideText = ChrW$(1030): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'І
                    Case 179
                    C.WideText = ChrW$(1110): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'і
                    Case 180
                    C.WideText = ChrW$(1169): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'ґ
                    Case 184
                    C.WideText = ChrW$(1105): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'ё
                    Case 186
                    C.WideText = ChrW$(1108): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'є
                    Case 191 To 255
                    C.WideText = ChrW$(N + 848): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'А-я
                    End Select
                End If
            Next C
        Next s
        d.EndCommandGroup
    End Sub

    об этом @_MBK_ спрашивает :)
     
    • Одобряю Одобряю x 1
  8. Это работает! СПАСИБО!!!