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中的导出图像大小？

相关信息

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

您的评论中并不清楚，但您可能会错过PowerPoint使用点（72英寸到英寸）作为尺寸而非英寸或像素的事实。

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

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

Answer 3

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

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

3 个答案: