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

avniv

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
Подскажите как изменить кодировку текста во всем макете. Может есть такой макрос? Есть corel X6 и X3
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 361
Реакции
10 886

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 361
Реакции
10 886
Надо отыскать весть текст на странице или документе и поменять на заданную кодировку или тупо кирилицу.
Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?
 

avniv

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
если бы я умел....
 

avniv

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?
В любо случае большое спасибо за подсказку. Буду дальше думать...
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 361
Реакции
10 886
Ну можно даже не менять ничего в макросе - выделяете все объекты и запускаете: он меняет в выделенных.
 

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 216
Реакции
2 106
Чего думать? файл-пример выложить куда-нить? может простая замена шрифта решит дело?
 

avniv

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
Выложить могу, но замена не решает. В ручную выходит по одному обекту, но группу или выделение нескольких замену кодировки не дает...
 

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 216
Реакции
2 106
так ить написано - в зип или рар или в другое место и сюда ссылку
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 361
Реакции
10 886
по одному обекту
Примерно как то так
Код:
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
 

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 216
Реакции
2 106
это было когда деревья были большими шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты стали отображаться серым цветом - а текст называться серым - граната не той системы
 

avniv

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
Примерно как то так
Код:
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

Топикстартер
15 лет на форуме
Сообщения
131
Реакции
1
это было когда деревья были большие шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты сталиотображаться серым цветом - а текст называться серым - граната не той системы
Смешно.