[CDR X5-X8] Изменить кодировку текста

[avniv]

Подскажите как изменить кодировку текста во всем макете. Может есть такой макрос? Есть corel X6 и X3

 

[dastin]

как изменить кодировку текста

из ? в ?
текст получен импортом стороннего файла?
или набран неюникодным шрифтом?

 

[_MBK_]

или набран неюникодным шрифтом?

Вангую чтото вроде этого

 

[avniv]

из ? в ?
текст получен импортом стороннего файла?
или набран неюникодным шрифтом?

Был когда то импортирован видимо.

 

[avniv]

Вангую чтото вроде этого

Это похоже, но не совсем то. Надо отыскать весть текст на странице или документе и поменять на заданную кодировку или тупо кирилицу.

 

[_MBK_]

Надо отыскать весть текст на странице или документе и поменять на заданную кодировку или тупо кирилицу.

Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?

 

[avniv]

если бы я умел....

 

[avniv]

Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?

В любо случае большое спасибо за подсказку. Буду дальше думать...

 

[_MBK_]

Ну можно даже не менять ничего в макросе - выделяете все объекты и запускаете: он меняет в выделенных.

 

[dastin]

Чего думать? файл-пример выложить куда-нить? может простая замена шрифта решит дело?

 

[avniv]

Выложить могу, но замена не решает. В ручную выходит по одному обекту, но группу или выделение нескольких замену кодировки не дает...

 

[avniv]

Чего думать? файл-пример выложить куда-нить? может простая замена шрифта решит дело?

Не удается прикрепить кореловский файл...

 

[dastin]

так ить написано - в зип или рар или в другое место и сюда ссылку

 

[avniv]

Ну можно даже не менять ничего в макросе - выделяете все объекты и запускаете: он меняет в выделенных.

Ни чего не меняет... А серый текст это что?

 

[_MBK_]

по одному обекту

Примерно как то так

Sub TranslateText()
      
    Dim txts As ShapeRange
    Dim sh as shape
    Set txts = 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
  next sh 
End Sub

 

[avniv]

так ить написано - в зип или рар или в другое место и сюда ссылку

Файл из Облака Mail.Ru

 

[dastin]

это было когда деревья были большими шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты стали отображаться серым цветом - а текст называться серым - граната не той системы

 

[avniv]

Примерно как то так

Sub TranslateText()
     
    Dim txts As ShapeRange
    Dim sh as shape
    Set txts = 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
  next sh
End Sub

FindShapes(процедура или функция не определенна).

 

[avniv]

это было когда деревья были большие шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты сталиотображаться серым цветом - а текст называться серым - граната не той системы

Смешно.

 

[avniv]

FindShapes(процедура или функция не определенна).

добавил ActivePage. но все равно ничего не меняет...