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

Cut shapes in half

Decription: Works on all shapes, even bitmaps. Works on multiple shapes as well. Reselects them so you can keep cutting click after click. Assign a shortcut to both divideVertically() and divideHorizontally().

Date: 2010-09-02 Author: John Johnson

Option Explicit

Sub divideVertically()
    cutInHalf 1
End Sub

Sub divideHorizontally()
    cutInHalf 2
End Sub

Private Sub cutInHalf(Optional method As Integer)
    Dim s As Shape, rect As Shape, rect2 As Shape
    Dim trimmed1 As Shape, trimmed2 As Shape
    Dim x As Double, y As Double, w As Double, h As Double
    Dim vBool As Boolean
    Dim leeway As Double
    Dim sr As ShapeRange, sr2 As New ShapeRange
    vBool = True
    If method = 2 Then
        vBool = False
    End If
    leeway = 0.1
    Set sr = ActiveSelectionRange
    ActiveDocument.BeginCommandGroup "Cut in half"
    For Each s In sr
        s.GetBoundingBox x, y, w, h
        If (vBool) Then
            'vertical slice
            Set rect = ActiveLayer.CreateRectangle2(x - leeway, y - leeway, (w / 2) + leeway, h + (leeway * 2))
            Set rect2 = ActiveLayer.CreateRectangle2(x + (w / 2), y - leeway, (w / 2) + leeway, h + (leeway * 2))
            Set rect = ActiveLayer.CreateRectangle2(x - leeway, y - leeway, w + (leeway * 2), (h / 2) + leeway)
            Set rect2 = ActiveLayer.CreateRectangle2(x - leeway, y + (h / 2), w + (leeway * 2), (h / 2) + leeway)
        End If
        Set trimmed1 = rect.Intersect(s, True, True)
        Set trimmed2 = rect2.Intersect(s, True, True)
        sr2.Add trimmed1
        sr2.Add trimmed2
    Next s
End Sub

Title: Monogram Macro for x6
Comment left by: Stephen @ Team Spirit
Date: 2014-07-29
Comment left:
 I am interested in the Monogram Macro but it says it's for x5 and lower and I've got it compatible with x6?


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 yahoo


find it on google