在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个矩形的位置,形成了层叠效果。
发表评论