Просматривают:
1 Анонимно
текс определенной гартнитуры в кривые |
||
|
||
---|---|---|
Новичок
Присоединился:
2005/10/29 12:58 Сообщений: 12
|
можно ли (и как) написать макрос, чтобы в документе он находил текст определенной гарнитуры и конвертил это в кривые. (ну и сохранял, за одно, поптом)
Опубликовано: 2008/9/18 16:12
|
|
|
Re: текс определенной гартнитуры в кривые |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2006/9/4 0:38 Откуда Минск
Сообщений: 262
|
а чем так плохо:
edit->find and replace->find objects забиваешь условия поиска. сохраняешь на диск, а вызов вешаешь на квиккей.?
Опубликовано: 2008/9/18 17:45
|
|
|
Re: текс определенной гартнитуры в кривые |
|
---|---|---|
Новичок
Присоединился:
2005/10/29 12:58 Сообщений: 12
|
это долго. есть куча файлов с кривой гарнитурой. и с ними надо проделать эту процедуру
Опубликовано: 2008/9/19 9:13
|
|
|
Re: текс определенной гартнитуры в кривые |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2006/9/4 0:38 Откуда Минск
Сообщений: 262
|
вот тебе макрос - выделяет вообще весь текст в файле... может поможет...
Sub textinfo() ' ======================================================================================== Dim s As Shape, p As Page, sr As ShapeRange, doc As Document, dd As Boolean, i# On Error Resume Next Set doc = ActiveDocument dd = doc.Dirty doc.ClearSelection Set p = ActivePage Set sr = p.FindShapes(, cdrTextShape, True) If sr.Count > 0 Then sr.CreateSelection: GoTo found If doc.Pages.Count = 1 Then Exit Sub For Each p In doc.Pages Set sr = p.FindShapes(, cdrTextShape, True) If sr.Count > 0 Then sr.CreateSelection: GoTo found Set s = p.FindShape(, cdrTextShape) If Not s Is Nothing Then s.Selected = True: GoTo found Next doc.Dirty = dd Exit Sub found: p.Activate Set sr = doc.SelectableShapes.All sr.RemoveRange doc.Pages(0).Layers("Guides".shapes.All With ActiveSelection i = IIf(.SizeWidth > .SizeHeight, .SizeWidth / sr.SizeWidth, .SizeHeight / sr.SizeHeight) End With With CorelDRAW.ActiveWindow.ActiveView .ToFitSelection If Abs(i - 1) > 0.2 Then _ .SetViewPoint .OriginX, .OriginY, .Zoom * IIf(i > 0.2, i, 0.2) End With doc.Dirty = dd End Sub
Опубликовано: 2008/9/19 18:00
|
|
|
Re: текс определенной гартнитуры в кривые |
|
---|---|---|
Новичок
Присоединился:
2005/10/29 12:58 Сообщений: 12
|
неее… весь текст не надо. только определенную гарнитуру
Опубликовано: 2008/9/22 17:39
|
|