Cara cepat Convert semua Text atau Tulisan di Semua Halaman CorelDraw

Ade Sanusi Desember 06, 2014
Tempo hari saya pernah share artikel tentang Cara Cepat Seleksi Tulisan, Objek, Guidlines dan Node di CorelDraw yang memungkinkan memilih text dalam 1 halaman sekaligus, tapi bagaimana jika kasusnya anda mempunyai banyak halaman yang berisi text di corelDraw ingin anda Convert untuk kepentingan di cetak atau agar tulisannya tidak mudah di jiplak orang lain maka harus anda Convert satu halaman per halaman dan tidak sekaligus.  Berikut ini ada solusinya dengan macro untuk Convert text sekaligus otomatis di semua halaman CorelDraw:

Update : Anda bisa Mengunjungi "Convert Semua Text Include Object pada PowerClip" yang merupakan update dari macro ini dan cara penggunaanya.

Berikut ini Kodenya untuk Semua Versi CorelDraw 11 s.d CorelDraw X7:

Private Sub ConvertGayaLama()

 Dim p As Page, s As Shape, sr As ShapeRange

 For Each p In ActiveDocument.Pages
    p.Activate
    Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)
    For Each s In sr
        s.ConvertToCurves
    Next s
Next p

 End Sub

Sedangkan untuk proses pencarian text lebih cepat bisa menggunakan kode di bawah ini (Untuk CorelDraw X3 ke Atas):

Private Sub convertAllToCurvesCQL()
Dim p As Page

For Each p In ActiveDocument.Pages
p.Activate
ActivePage.Shapes.FindShapes(Query:="@type = 'text:artistic'").ConvertToCurves
'ActivePage.Shapes.FindShapes(Query:="@type = 'text:paragraph'").ConvertToCurves
Next p

End Sub

Kode asli dari : http://community.coreldraw.com/talk/coreldraw_x3_and_older/f/18/t/24802?pi1364=3
Hilangkan tanda petik di depan code merah jika ingin convert text tipe paragraph juga.
Cara penggunaanya adalah klik menu Tools-Macros-Macro Editor... kemudian Cari GlobalMacros di projek Explorer dan Klik 2x pada Module GlobalMacros kemudian masukan kode di atas.

Kemudian Run untuk menjalankannya, atau anda bisa menggunakan Shorcut seperti pada Menambahkan Shorcut Baru pada CorelDraw

Demikian tutorial Convert semua Tulisan di Semua Halaman CorelDraw otomatis menggunakan Macro.
Tags

Posting Komentar

2 Komentar

  1. JR20 Februari 2015 pukul 20.33

    Sub TextToCurves()
    Dim srQ As ShapeRange, sr As ShapeRange, sr2 As ShapeRange, sh As Shape, _
    i&, curP As Page, bAll%, bDigPClip%
    On Error Resume Next
    If ActiveDocument Is Nothing Then Exit Sub
    Set curP = ActiveLayer.Page
    Set sr = New ShapeRange: Set sr2 = New ShapeRange: Set srQ = New ShapeRange
    bAll = (ActiveSelectionRange.Count = 0)
    bDigPClip = (VersionMajor > 11)
    For i = 1 To ActiveDocument.Pages.Count
    With ActiveDocument.Pages(i)
    If bAll Or .Index = curP.Index Then
    If bDigPClip Then
    If bAll Then sr.AddRange .FindShapes _
    Else: sr.AddRange ActiveSelection.Shapes.FindShapes
    Do
    For Each sh In sr
    If sh.Type = cdrTextShape Then srQ.Add sh
    If Not sh.PowerClip Is Nothing Then sr2.AddRange sh.PowerClip.Shapes.FindShapes
    Next
    sr.RemoveAll: sr.AddRange sr2: sr2.RemoveAll
    Loop Until sr.Count = 0
    Else
    If bAll Then srQ.AddRange .FindShapes(, cdrTextShape, True) _
    Else: srQ.AddRange ActiveSelection.Shapes.FindShapes(, cdrTextShape, True)
    End If
    End If
    End With
    Next


    srQ.CreateSelection
    num = (srQ.Count)

    If num = 1 Then
    srQ.ConvertToCurves
    MsgBox (num & " Objeto de texto convertido a Curvas") '& vbTab &
    srQ.AddToSelection

    ElseIf num > 1 Then
    srQ.ConvertToCurves
    MsgBox (num & " Objetos de texto convertidos a Curvas") '& vbTab &
    srQ.AddToSelection

    Else
    MsgBox ("No se encontró ningún objeto de texto en la selección o el Documento"), vbInformation '& vbTab &
    End If





    'srQ.CreateSelection 'JRM 2014

    End Sub

    BalasHapus
  2. Ade Sanusi23 Februari 2015 pukul 11.11

    Thanks for Your Code :)

    BalasHapus