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 and some v.2017 macros available as well as older versions. 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 v.2017. 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.
^ 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

Code:
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
#Else
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!

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

ActiveDocument.BeginCommandGroup
If sr.Shapes.count > 1 Then
Set s = sr.Group
Else
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
Else
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
ActiveDocument.EndCommandGroup

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


Title:
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.



gdg


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

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.

Thanks!



gdg






corel macros boost workflow
*Searches the FREE and Commercial Macros


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