在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

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

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

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

我鼓励你使用Shape Range，因为我们可以在代码中使用内置方法。