如何使用 vba 在 PowerPoint 中调整导出图像大小？

Question

我正在 PowerPoint VBA 中创建一个宏以从当前幻灯片中导出图像。导出图像将是第一个宽度大于 250 个单位的图像。图像存储为Shape，因此我执行For Each ... Next 循环来执行此操作。代码运行良好。

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

问题

导出的图像pic_VBA.jpg 比 PowerPoint 中显示的要小得多。 我想要图片的原始尺寸。 这个由 VBA pic_VBA.jpg 导出的图片尺寸为 331 x 413。如果我使用另存为图片...手动导出图像，导出的图像pic_SaveAs.jpg的尺寸为692 x 862，即原始尺寸。

• pic_VBA.jpg 尺寸：331 x 413
• pic_SaveAs.jpg 尺寸：692 x 862（原始尺寸）

我测试过的内容

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

它不起作用。导出图像的尺寸为 150 x 413

问题

那么，如何使用 vba 在 PowerPoint 中调整导出图像的大小？

---

相关信息

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

Answer 1

图像是否在 PowerPoint 中缩放？如果不是 100%，您需要计算 X/Y 维度中的比例 %，将其设置为 100%，将其导出，然后将其缩放回存储的设置。此功能将有助于：

' 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

您的 cmets 并不清楚，但您可能错过了 PowerPoint 使用点（72 点到英寸）作为尺寸，而不是英寸或像素这一事实。

将形状的大小从点转换为英寸，然后乘以 150 得到 PPT 将导出的大小。

这 150 可能因系统而异，但我不相信它会这样。

Answer 3

在Shape.Export 方法中使用ActivePresentation.PageSetup.SlideWidth 和ActivePresentation.PageSetup.SlideHeight 作为ScaleWidth 和ScaleHeight 来接收具有原始尺寸的图片文件。