在 VBA PowerPoint 中调整图像大小

Question

以下情况我需要帮助：

我编写了一个代码来调整幻灯片中所有图像的大小，但是我无法使每个图像具有不同的大小，当我使用宏时幻灯片的所有图像都是标准的.

遵循代码：

Sub Slide()

    Dim sld As Slide
    Dim img As Shape


    For Each sld In ActivePresentation.Slides
        For Each img In sld.Shapes

            With img                
                If .Type = msoLinkedPicture _
                Or .Type = msoPicture Then
                   .Left = 100
                   .Top = 100
                End If
            End With

        Next
    Next sld

End Sub

Answer 1

您可以将图像存储在一个形状范围内，然后在该形状范围内调用 different、distribution 和 align 方法。例如，我写了一些代码来存储图片在数组中的幻灯片上，设置图片的高度、宽度和左侧，然后垂直分布。

Sub OrganizingPicsInPPT()

    'Declare the Variables
    Dim PPTSld As Slide
    Dim PPTImg As Shape
    Dim ShpRng As ShapeRange
    Dim ShpArr() As Variant
    Dim ShpCnt As Integer

    'Loop through all the slides in the Actvie Presentation
    For Each PPTSld In ActivePresentation.Slides

        'Initalize my shape count that will be used in my Shape Array
        ShpCnt = 0

        'Loop through all the Shapes on the current slide
        For Each PPTImg In PPTSld.Shapes

            'If the image is linked or a picture then...
            If PPTImg.Type = msoLinkedPicture Or PPTImg.Type = msoPicture Then

               'Increment the shape count.
               ShpCnt = ShpCnt + 1

               'Resize the array, so it matches the shape count.
               ReDim Preserve ShpArr(1 To ShpCnt)

               'Add the Shape to the Array
               ShpArr(ShpCnt) = PPTImg.Name

            End If

        Next PPTImg

        'Set the Shape Range equal to the array we just created.
        Set ShpRng = PPTSld.Shapes.Range(ShpArr)

        'Set the dimensions of the shapes in the ShapeRange.
        With ShpRng

            .Height = 200
            .Width = 300
            .Left = 100

            .Distribute msoDistributeVertically, msoTrue

            'If the shape count is greater than one, I assume you will wanted it centered to the selected object.
            If ShpCnt > 1 Then
                .Align msoAlignCenters, msoFalse
            End If

        End With

        'Clear the array for the next loop
        Erase ShpArr

    Next PPTSld

End Sub

这在您的示例中不会完美运行，但它应该为您指明正确的方向。此时真正的问题是很难确定幻灯片上有多少个形状以及您希望它们如何排列。例如，如果有三个以上的形状，您想要幻灯片右侧的其他形状吗？一旦我们弄清楚了这一点，我们就可以帮助您指明正确的方向。

我鼓励您使用形状范围，因为我们可以在代码中利用内置方法。

在 VBA PowerPoint 中调整图像大小

Resize Image in VBA PowerPoint

powerpoint

vba