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

问题描述

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

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

问题

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

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 尺寸：331 x 413


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

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

我测试的内容

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

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

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

问题

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

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

相关信息

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

推荐答案

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

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

这篇关于如何使用vba调整PowerPoint中的导出图像大小？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！