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

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















 Helpful VBA Code
Please order a commercial macro ONLY if you have at least intermediate professional experience with CorelDraw and macros, no beginners PLEASE. Try FREE macros here and see my help pages to learn. You agree to all terms and conditions here when buying a commercial macro or free GDG Macros. No refunds, no exchanges.
Note: Macros do not function in the Home & Student Edition or Pirated Versions of CorelDraw!
Join ME on Facebook to stay up to date with news, updates. Subscribe to my YouTube Channel for tutorial videos and tips..
CorelDraw X8 is here! See new version policy here. Email and let me know which macro you need for X8. All macros without a request might be discontinued. I release them when I can so please be patient usually about one every week or so.

<<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

Code:
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))
        Else
            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)
        rect.Delete
        Set trimmed2 = rect2.Intersect(s, True, True)
        s.Delete
        rect2.Delete
        sr2.Add trimmed1
        sr2.Add trimmed2
    Next s
    ActiveDocument.EndCommandGroup
    
    sr2.CreateSelection
End Sub



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



gdg






corel macros boost workflow
*Searches the FREE and Commercial Macros


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