Sub Test() Dim d As Document Dim s As Shape Dim Filter As ExportFilter Set d = CreateDocument Set s = d.ActiveLayer.CreateEllipse2(4, 5, 2) s.Fill.ApplyFountainFill CreateRGBColor(255, 0, 0), CreateRGBColor(0, 0, 0) Set Filter = d.ExportBitmap("C:\Temp\Doc.jpeg", cdrJPEG, cdrCurrentPage, _ cdrRGBColorImage, 0, 0, 72, 72) With Filter .Compression = 80 .Optimized = True .Smoothing = 50 .SubFormat = 1 .Progressive = False .Finish End WithEnd Sub