I know there are some great macros out there that can do this, but I'm trying to implement it into my own macro.I'm trying to export a small jpg at 2000px on the longest end while maintaining the aspect ratio.I found the StructExportOptions.MaintainAspect property, but I'm having a hard time getting it to work.
Sub ExportJPGTest() Dim sr As ShapeRange Set sr = ActiveSelectionRange Dim X As Double, Y As Double, w As Double, h As Double Dim strFileName$, myPath$ Dim opt As New StructExportOptions Dim flt As ExportFilter myPath = "C:\Users\jchestnut\Proofs" 'change path here strFileName = ActiveDocument.Name With opt .AntiAliasingType = cdrNormalAntiAliasing .ImageType = cdrRGBColorImage .Overwrite = True .Compression = 5 .MaintainAspect = True .ResolutionX = 300 .ResolutionY = 300 End With sr.CreateSelection sr.GetBoundingBox X, Y, w, h If sr.SizeWidth > sr.SizeHeight Then With opt .SizeX = 2000 End With ElseIf sr.SizeHeight > sr.SizeWidth Then With opt .SizeY = 2000 End With ElseIf sr.SizeHeight = sr.SizeWidth Then With opt .SizeX = 2000 .SizeY = 2000 End With End If Set flt = ActiveDocument.ExportEx("C:\Users\jchestnut\Proofs\" & strFileName & ".jpg", cdrJPEG, cdrSelection, opt) flt.Finish If ActiveSelection.Shapes.Count = 0 Then MsgBox "Make a selection for export.": Exit Sub End Sub
not answer to your question, but you can try to look here
https://community.coreldraw.com/talk/coreldraw_graphics_suite_x8/f/coreldraw-graphics-suite-x8/53547/default-setting-for-export/256436#256436
This equation is what I was missing! opt.SizeY = 900 / ((w - x) / (h - y))Thanks, Mek!
Sub ExportJPGTest() Dim sr As ShapeRange Set sr = ActiveSelectionRange Dim X As Double, Y As Double, w As Double, h As Double Dim strFileName$ Dim opt As New StructExportOptions Dim flt As ExportFilter strFileName = ActiveDocument.Name With opt .AntiAliasingType = cdrNormalAntiAliasing .ImageType = cdrRGBColorImage .Overwrite = True .Compression = 5 .MaintainAspect = True .ResolutionX = 300 .ResolutionY = 300 End With sr.CreateSelection sr.GetBoundingBox X, Y, w, h If sr.SizeWidth > sr.SizeHeight Then With opt .SizeX = 2000 .SizeY = 2000 / ((w - X) / (h - Y)) End With ElseIf sr.SizeHeight > sr.SizeWidth Then With opt .SizeY = 2000 .SizeX = 2000 / ((w - X) / (h - Y)) End With ElseIf sr.SizeHeight = sr.SizeWidth Then With opt .SizeX = 2000 .SizeY = 2000 End With End If Set flt = ActiveDocument.ExportEx("C:\Users\jchestnut\Proofs\" & strFileName & ".jpg", cdrJPEG, cdrSelection, opt) flt.Finish If ActiveSelection.Shapes.Count = 0 Then MsgBox "Make a selection for export.": Exit Sub End Sub
For myself and anyone in the future. To remove the ".cdr" file extension from the file name use this.strFileName = Left(ActiveDocument.FileName, Len(ActiveDocument.FileName) - 4)