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

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

Helpful VBA Code
New 2024 GDG Macro Suite Soon, 50% off upgrade discount code will be emailed to all those who bought suite 2023. New in this suite, several "B" versions of macros, for those having issues with macros running in systems with international decimal settings.
Previous message (5-15-2024): Hi, all. Sorry for any lack of communication lately. I have been extremely busy running my graphics and car audio shop. The days are long with little rest. I finally had a chance to see some of your emails and will see what I can do about CorelDraw 2024 macros. I haven't decided on an exact direction but may release mini-suites, or just the whole suite again with upgrade pricing. The best deal of course would be the purchase of the GDG Macro Suite.
Available now! GDG Macros Suite 2023.
Please note: Macros 2023 and above will no longer be sold separately.
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

GDG Contour Quick

Decription: A quick contour macro. Two macros to run either the round or standard end types. I use to thicken thin fonts, but there can be many uses. Enjoy. See code comments, adjust as needed. ADDED: A fix up of yesterdays free Contour Quick macro. This adds a command group which basically means a single UNDO. It also adds the ability to quick change the contour distance. See the one time pop up that appears when you run it stating info about the functionality.

Date: 2014-01-06 Author: John GDG

Option Explicit

Const VK_SHIFT = &H10
Const VK_CTRL = &H11
Const VK_ESCAPE = &H1B
Const VK_ALT = &H12

#If VBA7 Then
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As LongPtr) As Integer
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Sub contourQuickRound()
contourQuickGo 1
End Sub
Sub contourQuickStandard()
contourQuickGo 0
End Sub
Sub contourQuickGo(c As Integer)
Dim s As Shape, sr As ShapeRange
Dim e As Effect
Dim d#, dDefault#
Dim eCapType As cdrContourEndCapType
Dim eCornerType As cdrContourCornerType
Dim strInput$, strMacroName$
Dim strMessage1$, bShown As Boolean

strMacroName = "GDG ContourQuick"
dDefault = 0.008

bShown = CBool(GetSetting(strMacroName, "Pref_" & VersionMajor, "msg_shown", False))
If Not bShown Then
strMessage1 = "Run either macro with SHIFT AND CTRL pressed to change contour distance." & vbCrLf & vbCrLf & _
"Running either of the macros with SHIFT pressed will double the contour distance." & vbCrLf & vbCrLf & _
"Running either of the macros with CTRL pressed will half the contour distance." & vbCrLf & vbCrLf & _
"This message will not appear again, ever. Read carefully."
MsgBox strMessage1, , strMacroName
SaveSetting strMacroName, "Pref_" & VersionMajor, "msg_shown", True
Exit Sub
End If

If c = 1 Then
eCornerType = cdrContourCornerRound '2
eCapType = cdrContourRoundCap '1
End If

ActiveDocument.Unit = cdrInch 'your document units < you set!
d = Val(CDbl(GetSetting(strMacroName, "Pref_" & VersionMajor, "contour_distance", 0.008))) 'use saved value or MY DEFAULT
'd = 0.008 'your medium distance < you set!

'multipliers for running macro with either shift or ctrl pressed, adjust as desired...
If isShiftPressed Then d = d * 2
If isCtrlPressed Then d = d / 2

If isShiftPressed And isCtrlPressed Then
strInput = InputBox("Enter a value for contour thickness.", strMacroName, d)
strInput = Trim(strInput)
If Len(strInput) = 0 Then MsgBox "No value entered, Exiting...", vbCritical, strMacroName: Exit Sub
If Not IsNumeric(strInput) Then MsgBox "Not a numeric value, Exiting...", vbCritical, strMacroName: Exit Sub
SaveSetting strMacroName, "Pref_" & VersionMajor, "contour_distance", strInput
Exit Sub
End If

Set sr = ActiveSelectionRange
If sr.count = 0 Then Exit Sub

If sr.Shapes.count > 1 Then
Set s = sr.Group
Set s = sr(1)
End If

Set e = s.CreateContour(1, d, 1)
If c = 1 Then
e.Contour.CornerType = eCornerType
e.Contour.EndCapType = eCapType
End If

Set sr = e.Separate()
Set s = sr(1)
If c = 1 Then
s.Fill.UniformColor.RGBAssign 0, 153, 51 ' green contour is made with square corners
s.Fill.UniformColor.RGBAssign 0, 0, 255 ' blue contour is made with round corners
End If
s.Outline.SetNoOutline 'of contour shape
s.CreateSelection 'select contour shape last

End Sub

'modifier keys begin ##############################################
Public Function ResetKeyStatus(Optional nada As Boolean) As Boolean
GetAsyncKeyState VK_SHIFT
GetAsyncKeyState VK_CTRL
GetAsyncKeyState VK_ESCAPE
ResetKeyStatus = True
End Function
Public Function isShiftPressed() As Boolean
isShiftPressed = (GetAsyncKeyState(VK_SHIFT) <> 0)
End Function
Public Function isCtrlPressed() As Boolean
isCtrlPressed = (GetAsyncKeyState(VK_CTRL) <> 0)
End Function
Public Function isEscPressed() As Boolean
isEscPressed = (GetAsyncKeyState(VK_ESCAPE) <> 0)
End Function
Public Function isAltPressed() As Boolean
isAltPressed = (GetAsyncKeyState(VK_ALT) <> 0)
End Function
'modifier keys begin ##############################################

Comment left by:
Date: 2015-02-17
Comment left:
HI. Make sure to have an item selected then run. See my videos on the YouTube for GDG Macros or the getting started with macros link on the left main menu above for info about where to place the code.


Title: How to impliment this?
Comment left by: Jason
Date: 2015-01-22
Comment left:

I do I get this macro to work for CorelDraw X4?
I tried adding it to the Global Macros, but it gives an error when trying to run the macro.



corel macros boost workflow
*Searches the FREE and Commercial Macros

CorelDraw macros for version 2023

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