Help to modify this macro

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)
    Dim s1 As Shape
    Set s1 = ActiveShape
    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
End Sub

Parents Reply Children
No Data