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

  • Автор темы Автор темы avniv
  • Дата начала Дата начала
A

avniv

Топикстартер
20 лет на форуме
Сообщения
137
Реакции
1
Подскажите как изменить кодировку текста во всем макете. Может есть такой макрос? Есть corel X6 и X3
 
avniv сказал(а):
Надо отыскать весть текст на странице или документе и поменять на заданную кодировку или тупо кирилицу.
Нажмите, чтобы раскрыть...
Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?
 
если бы я умел....
 
_MBK_ сказал(а):
Ну у меня там заготовка макроса есть - добавляете туда перебор всехвсехвсех текстовых блоков - это ли не то, что нам надо?
Нажмите, чтобы раскрыть...
В любо случае большое спасибо за подсказку. Буду дальше думать...
 
Ну можно даже не менять ничего в макросе - выделяете все объекты и запускаете: он меняет в выделенных.
 
Чего думать? файл-пример выложить куда-нить? может простая замена шрифта решит дело?
 
Выложить могу, но замена не решает. В ручную выходит по одному обекту, но группу или выделение нескольких замену кодировки не дает...
 
так ить написано - в зип или рар или в другое место и сюда ссылку
 
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
 
это было когда деревья были большими шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты стали отображаться серым цветом - а текст называться серым - граната не той системы
 
_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
Нажмите, чтобы раскрыть...
FindShapes(процедура или функция не определенна).
 
dastin сказал(а):
это было когда деревья были большие шрифты были неюникодными и с 10 версии корела файлы с текстом набранными такими шрифтами получили проблемс - шрифты сталиотображаться серым цветом - а текст называться серым - граната не той системы
Нажмите, чтобы раскрыть...
Смешно.
 
Для ответа нужно войти/зарегистрироваться
Верх Низ