OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 22-07-2004, 09:28
eric
Guest
 
Posts: n/a
Default 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
Reply With Quote
  #2  
Old 18-08-2004, 23:02
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: document name and created date in Corel drawing

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:

Code:
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:

Code:
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
Reply With Quote
  #3  
Old 23-08-2004, 03:24
eric
Guest
 
Posts: n/a
Default great solution!

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
Reply With Quote
  #4  
Old 23-08-2004, 16:06
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: great solution!

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

Code:
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
Reply With Quote
  #5  
Old 14-09-2004, 19:57
tarzan
Guest
 
Posts: n/a
Default I need some paid help

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
Reply With Quote
  #6  
Old 14-09-2004, 23:17
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: I need some paid help

Charles, just sent you a PM...
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -5. The time now is 07:07.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com