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. Clients agree to all terms and conditions here when buying a commercial macro and using the available free macros. No refunds, no exchanges.
Note: Macros do not function in the Home & Student Edition or Pirated Versions of CorelDraw!
X7 macros do not work in CorelDraw 2017
X8 macros do not work in CorelDraw 2018
Many CorelDraw 2019 macros are here!

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.
WINDOWS OS ONLY! Not all macros are guaranteed to be continued due to compatibility reasons or other. See new version policy here. Contact me and let me know which macro you need for the NEW CorelDraw 2019. All macros without requests could be discontinued.
I appreciate everyone! Upgrading macros and maintaining this site is quite a task. 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




Need a Custom Macro?
Available for a limited time only.

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