Sub Test() Dim opt As New StructExportOptions Dim s As Shape ActiveDocument.Unit = cdrInch Set s = ActiveLayer.CreateRectangle(0, 0, 1, 1) s.Fill.ApplyFountainFill CreateColorEx(5005, 255, 0, 0), _ CreateColorEx(5005, 0, 0, 0) opt.AntiAliasingType = cdrNormalAntiAliasing opt.ImageType = cdrRGBColorImage opt.Overwrite = True opt.ResolutionX = 72 opt.ResolutionY = 72 opt.SizeX = opt.ResolutionX * s.SizeWidth opt.SizeY = opt.ResolutionY * s.SizeHeight ActiveDocument.Export "C:\Rect.jpg", cdrJPEG, cdrSelection, optEnd Sub