如何用vba给ppt幻灯片中插入同尺寸大小的图形?

在ppt中,经常需要插入图形。

有时候需要基于幻灯片中已有的图形再插入相同尺寸大小的同样的图形。

如下图所示为ppt幻灯片中已有的6个矩形,现在需要再插入6个矩形,形成层叠的效果。

可以使用如下的vba代码:

Sub QQ1722187970()
    Dim oPPT As Presentation
    Dim oSlide As Slide
    Dim oCL As CustomLayout
    Dim oP As Shape
    '新的插入的图形
    Dim oNP As Shape
    '当前ppt演示文稿
    Set oPPT = PowerPoint.ActivePresentation
    With oPPT
        '遍历每一个幻灯片
        For Each oSlide In .Slides
            With oSlide
                '遍历每一个已有的矩形
                For i = 1 To 6
                    Set oP = .Shapes("矩形 " & i)
                    Set oNP = .Shapes.AddShape(msoShapeRectangle, 0, 0, 0, 0)
                    With oNP
                        sName = "矩形 " & 6 + i
                        .Name = sName
                        .Left = oP.Left
                        .Top = oP.Top
                        .Width = oP.Width
                        .Height = oP.Height
                        .TextFrame.TextRange.Text = "循环图片" & 6 + i
                    End With
                Next i
            End With
        Next
    End With
End Sub

结果如下图所示:

新插入的6个矩形占据了原来的6个矩形的位置,形成了层叠效果。

       

发表评论