GDG Code Chunks, Discussion, VBA Snippets for CorelDRAW, Simple Macro Helpers!

cool vba macros for corel gdg corel draw macros corel macros
VBA Corel Macro Help
john's macros
thanks for stopping by gdg macros















Helpful VBA Code

End of an era...
I had the pleasure of creating macros and keeping them up to date for years, but all good things must come to an end. Thank you for your years of support. The site will be left up for viewing only from now on. No macros will be available going forward, and please, do not email me asking that I update a macro or if I can sell an open license version. Thank you. ~John

Join me on Facebook to stay up to date with news, updates. Subscribe to my YouTube Channel for tutorial videos and tips. Need a custom macro? Contact me.
Not all macros are guaranteed to be continued due to compatibility reasons or other. Read new-version policy here.
I appreciate everyone! Upgrading macros and maintaining this site is quite a task for me. Want to contribute? Please DONATE
^ Hide these messages to save screen space ^

<<Back to helpful code list

Click to create guidelines, even inside powerclips

Decription: This is a modification of code posted by wOxxOm. It now adds ability to create the guidelines inside powerclips and also adds a quick delete sub for the guidelines inside the powerclips. I wrote this quick and didn't do a lot of testing but it works. Modify as needed.

Date: 2010-05-09 Author: wOxxOm, modified by John

Code:
Sub DrawGuideHorizontal2()
    Dim p As lpPoint, x As Double, y As Double, l As Layer
    Dim pwc As PowerClip
    Dim s As Shape, sg As Shape
    Dim x1 As Double, y1 As Double, w1 As Double, h1 As Double
    
    GetCursorPos p
    ActiveWindow.ScreenToDocument p.x, p.y, x, y
    Set s = ActivePage.SelectShapesAtPoint(x, y, True).Group
    If Not s Is Nothing Then s.GetBoundingBox x1, y1, w1, h1
    Set l = ActiveLayer
    Set pwc = Nothing
    On Error Resume Next
    Set pwc = s.PowerClip
    On Error GoTo 0
    If Not pwc Is Nothing Then
        pwc.EnterEditMode
        Set sg = ActiveLayer.CreateLineSegment(x1, y, x1 + w1, y)
        sg.Outline.Color.CMYKAssign 100, 0, 0, 0
        sg.Outline.SetProperties Style:=OutlineStyles(8), DashDotLength:=0#
        sg.Name = "tempGuide"
        pwc.LeaveEditMode
    Else
1001
        ActivePage.Layers("Guides").createGuide x, y, x + 1, y
    End If
    l.Activate

End Sub

Sub DrawGuideVertical2()
    Dim p As lpPoint, x As Double, y As Double, l As Layer
    Dim pwc As PowerClip
    Dim s As Shape, sg As Shape
    Dim x1 As Double, y1 As Double, w1 As Double, h1 As Double
    
    GetCursorPos p
    ActiveWindow.ScreenToDocument p.x, p.y, x, y
    Set s = ActivePage.SelectShapesAtPoint(x, y, True).Group
    If Not s Is Nothing Then s.GetBoundingBox x1, y1, w1, h1
    Set l = ActiveLayer
    Set pwc = Nothing
    On Error Resume Next
    Set pwc = s.PowerClip
    On Error GoTo 0
    If Not pwc Is Nothing Then
        pwc.EnterEditMode
        Set sg = ActiveLayer.CreateLineSegment(x, y1, x, y1 + h1)
        sg.Outline.Color.CMYKAssign 100, 0, 0, 0
        sg.Outline.SetProperties Style:=OutlineStyles(8), DashDotLength:=0#
        sg.Name = "tempGuide"
        pwc.LeaveEditMode
    Else
1001
        ActivePage.Layers("Guides").createGuide x, y, x + 1, y
    End If
    l.Activate

End Sub

Sub deleteGuidelinesInPC()

Dim s As Shape, sr As ShapeRange
Dim pwc As PowerClip, sp As Shape

Set sr = ActivePage.FindShapes

For Each s In sr
    Set pwc = Nothing
    On Error Resume Next
    Set pwc = s.PowerClip
    On Error GoTo 0
    If Not pwc Is Nothing Then
        For Each sp In pwc.Shapes.All
            If sp.Name = "tempGuide" Then sp.Delete
        Next sp
    Else
        If s.Name = "tempGuide" Then s.Delete
    End If
Next s
End Sub


corel macros boost workflow
*Searches the FREE and Commercial Macros


CorelDraw macros for version 2020

CorelDraw macros for version 2019

CorelDraw macros for version 2018

CorelDraw macros for version 2017

macros for coreldraw x8

macros for coreldraw x7

macros for corel draw x6

macros for corel draw x6

FIND IT ON

find it on yahoo

FIND IT ON

find it on google