OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Exproting to fixed size with current time as file name (http://forum.oberonplace.com/showthread.php?t=5982)

vindaa 18-07-2008 03:06

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

wOxxOm 18-07-2008 07:38

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


vindaa 18-07-2008 13:26

Thanks a lot

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

Once again Thanks a lot


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

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