开发者

PowerPoint VBA: How to save a pic in a particular file format & not the whole presentation?

开发者 https://www.devze.com 2023-02-05 22:10 出处:网络
I\'m using vba in PowerPoint.I\'m trying to compress orginal picture files from a specified folder to a smaller size.I was able to achieve that.However, I want to save the new compressed picture into

I'm using vba in PowerPoint. I'm trying to compress orginal picture files from a specified folder to a smaller size. I was able to achieve that. However, I want to save the new compressed picture into a destination folder.

The following code will save the presenation or slide with the picture. But I only want the picture. I'm pretty sure I have to use ActivePresentation.SaveAs. But it will only let me save the slide. How can I save the pic alone & not the slide?

Also, I seem to have another problem when I try to save the modified pic. It saves the presentation into a folder in the destination with a filename of "Slide1.bmp". Any idea why & how can I change this?

Dim strSrcPath As String, strDestPath As String
Dim strSrcPic As String
Dim objPic As Shape
Dim x as Integer

strSrcPath = "C:\Temp\Pics\In\"
strDestPath = "C:\Temp\Pics\Out\"

strSrcPic = Dir(strSrcPath)    

Do While strSrcPic <> ""
    x = x + 1
    Set objPic = ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=strSrcPath & strSrcPic, _
        LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=100, _
        Height:=100)
    With objPic
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
    End With

    objPic.Select

    ActivePresentation.SaveAs _
        FileName:=strDestPath & "ModPicture(" & x & ").bmp", _
        FileFormat:=ppSaveAsBM开发者_JAVA技巧P, EmbedTrueTypeFonts:=msoFalse
    objPic.Delete
    strSrcPic = Dir    'Get next entry.
Loop


Thanks @JSRWilson for the following response:

"You do have to right click in View >Object Browser >> Show Hidden Members Assuming objPic is still a reference to the compressed pic

objPic.Export(strDestPath & "& "ModPicture(" & x & ").bmp", ppSaveAsBMP)"

0

精彩评论

暂无评论...
验证码 换一张
取 消