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


发表评论