View Single Post
  #1  
Old 18-07-2008, 03: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