document name and created date in Corel drawing

Hi,

I want to keep track of all my printed designs and want to add information to the printed sheet automaticly.(in a template)

I want to show at least document name (ie. number), without path info.
and if possible also date and name of creator.
The file information should update when saved to a new name!

hope someone can help me with this.

thanks for your help,

Eric

[Alex]

Eric,

What I would do is to add an application event handler for BeforeSave event (in CorelDRAW 12) which will update the document with the file information just before it is being saved.

To do this, go to VBA in CorelDRAW 12 and in Project Explorer (Ctrl-R) go to GlobalMacros project (or any of your own if you like) and expand the "CorelDRAW 12 Objects" folder, there you'll see "ThisMacroStorage" module.

Double click on it to open the code window. In the code window there are two list boxes on the top. In the left one select "GlobalMacroStorage" element and in the right one - DocumentBeforeSave. This should automatically insert GlobalMacroStorage_DocumentBeforeSave event handler for you just like this:

Private Sub GlobalMacroStorage_DocumentBeforeSave(ByVal Doc As Document, ByVal SaveAs As Boolean, ByVal FileName As String)

End Sub

Now you can put your code in it to create/update file name label. Here is a sample which will either create a new label at the bottom of each page if it's not already there or update it if saving to a different file name:

Private Sub GlobalMacroStorage_DocumentBeforeSave(ByVal Doc As Document, ByVal SaveAs As Boolean, ByVal FileName As String)
    Const LabelName As String = "DocLabel" ' The special name to mark the text label with
    Dim p As Page
    Dim CurPage As Page
    Dim s As Shape
    Dim CurSelection As ShapeRange
    
    ' Remember the current page
    Set CurPage = Doc.ActivePage
    ' Remember the current selection
    Set CurSelection = Doc.SelectionRange
    ' Go through every page and check for the labels
    For Each p In Doc.Pages
        ' Find the text label by object name
        Set s = p.FindShape(LabelName, cdrTextShape)
        If s Is Nothing Then
            ' The label doesn't exist. Create it
            Set s = p.ActiveLayer.CreateArtisticText(p.SizeWidth / 2, 0.2, FileName, Font:="Arial", Size:=10, Alignment:=cdrCenterAlignment)
            ' Set the special name to it
            s.Name = LabelName
        ElseIf SaveAs Then
            ' The label exists, but we are saving to another file. Update the label
            s.Text.Story = FileName
        End If
    Next p
    ' Restore the current page
    CurPage.Activate
    ' Restore the selection
    CurSelection.CreateSelection
End Sub

Alex,

This works great.

There's only one thing I would like to change;

Is it possible to insert just the filename, without the filepath?
Also maybe without .cdr extension, so we could insert the filename as a document number.


Thank for your help.

eric

[Alex]

Eric,

It's quite easy to do. You can use VBA's InStrRev function which finds a substring in a string performing the search from the end of the string to the beginning (in reverse order). First you look for the last "\" character in the string and take the remainder of the string following the backslash.

Then, in the resulting string, search for "." (going backwards too) and take everything from the dot to the beginning of the string (to the left of the character).

Here is how the resulting macro will look like. I have indicated the biggest portion of the code I inserted to extract the file name without the path and extension with a special comment. I put the file name alone to a new variable - NameString and use it later on when creating a text object or updating the existing one...

Private Sub GlobalMacroStorage_DocumentBeforeSave(ByVal Doc As Document, ByVal SaveAs As Boolean, ByVal FileName As String)
    Const LabelName As String = "DocLabel" ' The special name to mark the text label with
    Dim p As Page
    Dim CurPage As Page
    Dim s As Shape
    Dim CurSelection As ShapeRange
    
    '===================== File Name Change starts here ==================
    Dim NameString As String
    Dim n As Long
    
    ' Remove the path from the file name
    n = InStrRev(FileName, "\")
    If n <> 0 Then
        NameString = Mid(FileName, n + 1)
    Else
        NameString = FileName
    End If
    
    ' Remove the file extension
    n = InStrRev(NameString, ".")
    If n <> 0 Then
        NameString = Left(NameString, n - 1)
    End If
    
    '===================== File Name Change ends here ==================
    
    ' Remember the current page
    Set CurPage = Doc.ActivePage
    ' Remember the current selection
    Set CurSelection = Doc.SelectionRange
    ' Go through every page and check for the labels
    For Each p In Doc.Pages
        ' Find the text label by object name
        Set s = p.FindShape(LabelName, cdrTextShape)
        If s Is Nothing Then
            ' The label doesn't exist. Create it
            Set s = p.ActiveLayer.CreateArtisticText(p.SizeWidth / 2, 0.2, NameString, Font:="Arial", Size:=10, Alignment:=cdrCenterAlignment)
            ' Set the special name to it
            s.Name = LabelName
        ElseIf SaveAs Then
            ' The label exists, but we are saving to another file. Update the label
            s.Text.Story = NameString
        End If
    Next p
    ' Restore the current page
    CurPage.Activate
    ' Restore the selection
    CurSelection.CreateSelection
End Sub

This is exactly (I think) what I have been looking for. But, I am a CorelDraw VBA nimrod. Would you be up for some paid assistance?

I think what I need is a fully written .gms file which I can put in place for use. I am so far behind the curve on this that I also need help (step-by-step instructions) on how to insert the VBA into my templates... or, how I should invoke the Macro.

So... HELP!

thanks
Charles

[Alex]

Charles, just sent you a PM...