V-Форум / Corel VBA / Тема: текс определенной гартнитуры в кривые

текс определенной гартнитуры в кривые

 18/09/2008 16:12:16 #Link

можно ли (и как) написать макрос, чтобы в документе он находил текст определенной гарнитуры и конвертил это в кривые. (ну и сохранял, за одно, поптом)

Re: текс определенной гартнитуры в кривые

 18/09/2008 17:45:31 #Link

а чем так плохо:
edit->find and replace->find objects

забиваешь условия поиска. сохраняешь на диск, а вызов вешаешь на квиккей.?

Re: текс определенной гартнитуры в кривые

 19/09/2008 9:13:44 #Link

это долго. есть куча файлов с кривой гарнитурой. и с ними надо проделать эту процедуру

Re: текс определенной гартнитуры в кривые

 19/09/2008 18:00:43 #Link

вот тебе макрос - выделяет вообще весь текст в файле... может поможет...
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

Re: текс определенной гартнитуры в кривые

 22/09/2008 17:39:38 #Link

неее… весь текст не надо. только определенную гарнитуру