I'm trying to insert a date into a label. I have written the following code. I can select a date by clicking on the arrow and the calendar pops up. The "CANCEL" button is working, but when I click "OK" I cannot get it to insert on the label. The label is a regular Corel document with text and images. I tried inserting a rectangle toolbox to see if I can get it to insert the date in there by using X,Y coordinates but that didn't work. I basically need to know how to insert DTPicker.Value onto the label.
DTPicker.Value
I've tried this : 1. Add a button on macro form 2. Select the rectangle 3. Click the button 4. Macro will read X, Y Pos of the rectangle, then create text and positioning it on the center of the rectangle.
Please see my post on stackOverflow for more details: http://stackoverflow.com/questions/32389241/coreldraw-x6-macro-to-insert-date-using-dtpicker-control/32502426#32502426. Thank you.
--------------------------
Private Sub OK_Click()
Dim sr As Shape Set sr = ActivePage.SelectableShapes.FindShapes.All
CorelDRAW.ActiveDocument.ReferencePoint = cdrCenter ActiveWindow.RulerOriginX = cdrCenter ActiveWindow.RulerOriginY = cdrCenter
ActiveDocument.ActiveLayer.Selected = True CorelDRAW.ActiveDocument.Unit = cdrInchSet sh = CorelDRAW.ActiveLayer.CreateArtisticText(0, 0, CStr(DTPicker1.Value)) MsgBox sh sh.PositionX = XPos sh.PositionY = YPos
'Unload MeEnd Sub
You have a couple problems with your code. First you will want to check that the DTPicker1.Value has a value or you could get and error as CreateArtisticText does not like an empty string.
Second, you have a message box trying to display a shape. That is going to give you an Object doesn't support this property or method error. If you want the message box to display the text you would need to do this:
MsgBox sh.Text.Story
Also you are not setting XPos or YPos to any value, unless they are coming from another section of your code. Here is how I would do this:
Private Sub OK_Click() Dim sr As ShapeRange Dim x As Double, y As Double Dim strMyDate As String Dim sDate As Shape 'Set our ShapeRange to all the shapes on the active page Set sr = ActivePage.Shapes.All 'Get the bottom left position of the ShapeRange sr.GetPositionEx cdrBottomLeft, x, y 'Get the date from the DatePicker strMyDate = DatePicker1.Value 'Check to make sure the string is not empty, CreateArtisticText does not like an empty string If strMyDate <> "" Then 'Create the text with the date at the bottom left corner of the ShapeRange Set sDate = ActiveLayer.CreateArtisticText(x, y, strMyDate) 'Move the text the distance of the height sDate.Move 0, -sDate.SizeHeight End If End Sub
As you can see, I select all the shapes on the page, get the bottom left position of them and then create some artistic text with your date value. I then move the text down the height of the text so that it is not running into any of the shapes.
Hopefully that helps. Just as a word of caution I would stay away from using the DatePicker if you are going to distribute your code. In general you need Office to make sure that it is installed on your machine and it is 32-bit only. So anyone using the 64-bit version of CorelDRAW X6 is not going to be able to use it.
I recently completed a project that needed several dates and I decided to use a custom docker with jQuery and jQuery UI, you can see the Date Picker in action below.
-Shelby
Alright, Angie was able to get my her file and it was very helpful. What she is trying to do is place the date next to a string of artistic text that says, EXP. DATE
There are several ways she could accomplish this. if you want the font and font size to match the EXP. DATE text then a simple find and replace will do the trick.
Private Sub OK_Click() Dim p As Page Dim strMyDate As String 'Get the date from the DatePicker strMyDate = CStr(DTPicker1.Value) 'Check to make sure the string is not empty, CreateArtisticText does not like an empty string If strMyDate <> "" Then 'Loop through each page in the Active Document For Each p In ActiveDocument.Pages 'Find any EXP. DATE text and replace it with EXP. DATE and current Date p.TextReplace "EXP. DATE", "EXP. DATE" & " " & strMyDate, True, False Next p End If Set p = Nothing End Sub
Another approach is the find the EXP. DATE text and then create a new line of artistic text next to it with the date. I made the text larger, bold, and then centered it vertically to the EXP. DATE text so that it would look nice.
Private Sub OK_Click() Dim p As Page Dim x As Double, y As Double Dim strMyDate As String Dim sr As ShapeRange Dim s As Shape, sDate As Shape 'Get the date from the DatePicker strMyDate = CStr(DTPicker1.Value) 'Check to make sure the string is not empty, CreateArtisticText does not like an empty string If strMyDate <> "" Then 'Loop through each page in the Active Document For Each p In ActiveDocument.Pages 'Find all shapes that contain the text EXP. DATE Set sr = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' and @Com.Text.Story.text = 'EXP. DATE'") For Each s In sr.Shapes 'Get the Bottom Right Position of the Text s.GetPositionEx cdrBottomRight, x, y 'Create the Date Text space it .125 from the EXP. DATE Text Set sDate = ActiveLayer.CreateArtisticText(x + 0.125, y, strMyDate, , , "Times New Roman", 12, cdrTrue) 'Center the new Date Vertically with the EXP. Text sDate.AlignToShape cdrAlignVCenter, s Next s Next p End If 'Clean things up Set sDate = Nothing Set s = Nothing Set p = Nothing End Sub
Again, there are other ways to do something similar, in fact the find and replace could be done in CorelDRAW without any code at all. These are just two approaches that hopefully will be helpful for others to learn from.
Thank you so much!!! Both ways work perfectly. You are great at what you do. So glad I found you. I would like to know how to go about intalling/running this on another machine. Do I create an add-in? Do I just save the document and run it on the other machine by enabling macro? How about if I want to use it for different documents (EXP. DATE will remain on all documents)?