Hi all. I m new so I expect to ask the rigth mode.I record a macro that has to be modified in order to achieve my goals. I need to import an image, place each one on the page, scale it, save as ( with the same name.cdr) and delete it. All this several hundred times. All are in the same folder.
Sub IPSSA1() ' Recorded 6/4/2021 ' ' Description: ' Import image,place it,scale it ,save as image name.cdr and delete the image Dim impopt As StructImportOptions Set impopt = CreateStructImportOptions With impopt .Mode = cdrImportFull .MaintainLayers = True With .ColorConversionOptions .SourceColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%" .TargetColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%" End With End With Dim impflt As ImportFilter Set impflt = ActiveLayer.ImportEx("F:\Documents\image1.jpg", cdrJPEG, impopt) impflt.Finish Dim s1 As Shape Set s1 = ActiveShape ActiveLayer.Shapes.All.CreateSelection ActiveSelection.Move -3.577752, 5.063937 ActiveDocument.ReferencePoint = cdrTopLeft ActiveSelection.Stretch 31.389132 Dim SaveOptions As StructSaveAsOptions Set SaveOptions = CreateStructSaveAsOptions With SaveOptions .EmbedVBAProject = True .Filter = cdrCDR .IncludeCMXData = False .Range = cdrAllPages .EmbedICCProfile = True .Version = cdrCurrentVersion End With ActiveDocument.SaveAs "F:\Documents\image1.cdr", SaveOptions ActiveSelection.DeleteEnd Sub
Does this one work? If not where is it failing?
Hi Myron, thanks for your reply. I would like to make it recursive? Image1, then image2 and so on with all the files in the folder.