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 18-07-2008, 04:06
vindaa
Guest
 
Posts: n/a
Default Exproting to fixed size with current time as file name

I want to export the selected objects as jpg file such that the canvas size remains 8 X 12 inch

If the selection is less than 8 X 12 the selected object remain of same size the space around it remains blank or if the selected object is larger than 8 X 12 the object is proportionally scaled to fit the 8 X 12 canvas size (if the selected object is wider the canvas would be landscape(12 X 8) or otherwise portrait.

I have almost done that but since I don't know VB, I have done that be editing the recorded macros. The problem is that I want the jpg files to be named as current date+time how do I do that. That is the file name should be some thing like 18-7-2008 11:55.jpg.

How do I do that.


Sub CanvasA()
'
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim s1 As Shape

If OrigSelection.SizeHeight < OrigSelection.SizeWidth Then
Set s1 = ActiveLayer.CreateRectangle(0, 0, 12, 8)
s1.Fill.ApplyNoFill
s1.Outline.SetProperties 0
s1.AlignToShape cdrAlignHCenter, OrigSelection(1), cdrTextAlignBoundingBox
s1.AlignToShape cdrAlignVCenter, OrigSelection(1), cdrTextAlignBoundingBox
Dim s2 As Shape
Set s2 = ActiveLayer.CreateRectangle(0, 0, OrigSelection.SizeWidth, (OrigSelection.SizeWidth * 0.666666666666667)) 'that is 12/8
s2.Fill.ApplyNoFill
s2.Outline.SetProperties 0
ActiveDocument.CreateSelection s1, s2
ActiveSelection.AlignToShape cdrAlignHCenter, OrigSelection(1), cdrTextAlignBoundingBox
ActiveDocument.CreateSelection s1, s2
ActiveSelection.AlignToShape cdrAlignVCenter, OrigSelection(1), cdrTextAlignBoundingBox
Dim expflt As ExportFilter
OrigSelection.AddToSelection

Set expflt = ActiveDocument.ExportBitmap("C:\To Print\16 july\0a.jpg", cdrJPEG, cdrSelection, cdrRGBColorImage, 3599, 2400, 300, 300, cdrNormalAntiAliasing, False, False, True, False, cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 0
.Smoothing = 0
.Finish
End With
s1.Delete
s2.Delete

Else
' Condition evaluates to True so the next statement is executed.
Dim s4 As Shape
Set s4 = ActiveLayer.CreateRectangle(0, 0, 8, 12)
s4.Fill.ApplyNoFill
s4.Outline.SetProperties 0
s4.AlignToShape cdrAlignHCenter, OrigSelection(1), cdrTextAlignBoundingBox
s4.AlignToShape cdrAlignVCenter, OrigSelection(1), cdrTextAlignBoundingBox
Dim s3 As Shape
Set s3 = ActiveLayer.CreateRectangle(0, 0, (OrigSelection.SizeHeight * 0.666666666666667), OrigSelection.SizeHeight)
s3.Fill.ApplyNoFill
s3.Outline.SetProperties 0
ActiveDocument.CreateSelection s4, s3
ActiveSelection.AlignToShape cdrAlignHCenter, OrigSelection(1), cdrTextAlignBoundingBox
ActiveDocument.CreateSelection s4, s3
ActiveSelection.AlignToShape cdrAlignVCenter, OrigSelection(1), cdrTextAlignBoundingBox
' Dim expflt As ExportFilter
OrigSelection.AddToSelection
Set expflt = ActiveDocument.ExportBitmap("C:\To Print\16 july\0b.jpg", cdrJPEG, cdrSelection, cdrRGBColorImage, 2400, 3599, 300, 300, cdrNormalAntiAliasing, False, False, True, False, cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 0
.Smoothing = 0
.Finish
End With
s4.Delete
s3.Delete
End If
End Sub
Reply With Quote
  #2  
Old 18-07-2008, 08:38
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

filesystem filename rules don't permit special characters like :\<>| otherwise it would be easy to set filename to "FormatDateTime(now)".

A manual composition is safe:

Code:
dim sTodayFolder as string, sFileTimeStamp as string
sTodayFolder = "C:\To Print\" & day(now) & " " & MonthName(month(now))
sFileTimeStamp = day(now) & "-" & month(now) & "-" & year(now) & " " & _
			hour(now) & "." & minute(now) & ".jpg"

if dir(sTodayFolder, vbDirectory) = "" then MkDir sTodayFolder

Set expflt = ActiveDocument.ExportBitmap(sTodayFolder & "\" & sFileTimeStamp, .....)

Last edited by wOxxOm; 18-07-2008 at 08:46.
Reply With Quote
  #3  
Old 18-07-2008, 14:26
vindaa
Guest
 
Posts: n/a
Default

Thanks a lot

Very thoughtful of you to add the Make folder option, I almost missed it.

Once again Thanks a lot
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

Similar Threads
Thread Thread Starter Forum Replies Last Post
Is there a maximum file size for CorelDRAW? jahmer General 4 10-07-2008 17:04
External symbol libraries and file size jahmer General 0 07-07-2008 15:05
dividing a curve into fixed distances between nodes Jeff Harrison CorelDRAW/Corel DESIGNER VBA 0 05-09-2007 04:17
How sets size form same as size images ? woycek21 Corel Photo-Paint VBA 0 09-07-2005 13:30
how do i get a fixed ... chinkyk CorelDRAW/Corel DESIGNER VBA 1 29-10-2004 19:44


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


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