How to adjust export image size in PowerPoint using vba?

Question

I'm creating a macro in PowerPoint VBA to export an image from the current slide. The export image will be the first image having a width larder than 250 units. The image is stored as a Shape, so I do a For Each ... Next loop to do it. The code works fine.

Function FindAndSavePicture() As String
'
' Find the target picture at the active windows
'
'
    Dim myTempPath As String
    myTempPath = "C:\Users\" & Environ$("USERNAME") _ 
            & "\AppData\Local\Microsoft\Windows\pic_VBA.jpg"

    With ActiveWindow.Selection.SlideRange
        For Each s In .Shapes
            Debug.Print s.Name
            If s.Type = msoPicture And s.Width > 250 Then

                ' Show scale
                Debug.Print "s.Width=" & s.Width    ' s.Width=323,3931
                Debug.Print "s.Height=" & s.Height  ' s.Height=405

                ' Save pic in file system
                s.Export myTempPath, ppShapeFormatJPG

                ' assign the return value for this function
                FindAndSavePicture = myTempPath
                Exit For

            End If
        Next
    End With
End Function

Problem

The exported image pic_VBA.jpg is much smaller than it is shown in the PowerPoint. I want the original size of the picture. This exported image by VBA pic_VBA.jpg has 331 x 413 in dimensions. And if I export the image manually using Save As Picture..., the exported image pic_SaveAs.jpg has 692 x 862 in dimensions, which is the original size.

• pic_VBA.jpg dimensions : 331 x 413
• pic_SaveAs.jpg dimensions : 692 x 862 (original size)

What I've tested

s.Export myTempPath, ppShapeFormatJPG, s.Width, s.Height, ppScaleXY

It doesn't work. The export image's dimensions are 150 x 413

Question

So, how to adjust export image size in PowerPoint using vba ?

---

Related infomations

• MSDN: Shape.Export Method
• MSDN: PpExportMode Enumeration

Answer 1

Is the image scaled in PowerPoint? If it's anything but 100%, you'll need to work out the scale % in X/Y dimensions, set it to 100%, export it and then scale it back to the stored settings. This function will assist with that:

' Function to return the scale percentages of a given picture shape
' Written by: Jamie Garroch of YOUpresent.co.uk

Public Type ypPictureScale
  ypScaleH As Single
  ypScaleW As Single
End Type

' Calculate the scale of a picture by resetting it to 100%,
' comparing with it's former size and then rescaling back to it's original size
Public Function PictureScale(oShp As Shape) As ypPictureScale
  Dim ShpW As Single, ShpH As Single
  Dim LAR As Boolean

  ' Save the shape dimensions
  ShpH = oShp.height
  ShpW = oShp.width

  ' Unlock the aspect ratio if locked
  If oShp.LockAspectRatio Then LAR = True: oShp.LockAspectRatio = msoFalse

  ' Rescale the image to 100%
  oShp.ScaleHeight 1, msoTrue
  oShp.ScaleWidth 1, msoTrue

  ' Calculate the scale
  PictureScale.ypScaleH = ShpH / oShp.height
  PictureScale.ypScaleW = ShpW / oShp.width

  ' Rescale the image to it's former size
  oShp.ScaleHeight PictureScale.ScaleH, msoTrue
  oShp.ScaleWidth PictureScale.ScaleW, msoTrue

  ' Relock the aspect ratio if originally locked
  If LAR Then oShp.LockAspectRatio = msoFalse
End Function

Answer 2

It's not clear from your comments, but you may be missing the fact that PowerPoint uses points (72 points to the inch) as dimensions, not inches or pixels.

Convert the size of the shape from points to inches then multiply by 150 to get the size PPT will export to.

That 150 may vary from one system to another, but I don't believe it does.

Answer 3

Use ActivePresentation.PageSetup.SlideWidth and ActivePresentation.PageSetup.SlideHeight as ScaleWidth and ScaleHeight in the Shape.Export method to receive a picture file with the original dimensions.