如何用vba根据ppt幻灯片中的已有图形插入生成一个N×M的相同图形?

如下图所示为ppt幻灯片中已有的一个椭圆形:

现在希望快速地在当前幻灯片中插入一个75个同尺寸大小的椭圆形,如下图所示排列:

这是一个典型的根据已有图形插入一个N×M型图形的问题

可以使用如下的vba通用代码:

Sub QQ1722187970()
    Dim oPPT As Presentation
    Dim oSlide As Slide
    Dim oOldShape As Shape
    Dim oNewShape As Shape
    '当前ppt演示文稿
    Set oPPT = PowerPoint.ActivePresentation
    With oPPT
        '在第一个幻灯片上操作
        Set oSlide = .Slides(1)
            With oSlide
                '总共80个
                iTotalNum = 75
                '每行放10个
                iPerNum = 10
                '已有图形的名称为Num1
                Set oOldShape = .Shapes("Num1")
                '先设置已有图形的尺寸
                With oOldShape
                    .Width = 20
                    .Height = 20
                End With
                For i = 1 To iTotalNum - 1
                    sName = "Num" & i + 1
                    '插入新的椭圆
                    Set oNewShape = .Shapes.AddShape(msoShapeOval, 0, 0, 0, 0)
                    With oNewShape
                        .Name = sName
                        '长宽一样
                        .Width = oOldShape.Width
                        .Height = oOldShape.Height
                        '左边依次递增,此处的10为图形之间的横向间隔
                        .Left = oOldShape.Left + (oOldShape.Width + 10) * (i Mod iPerNum)
                        '上下依次递增,此处的5为图形之间的上下间隔
                        .Top = oOldShape.Top + (oOldShape.Height + 5) * Int(i / iPerNum)
                    End With
                Next i
            End With
    End With
End Sub
       

发表评论