PPT自动载入图片并矩阵分布

最近有学生问到，能不能快速的向PPT一个页面里插入成百张图片，并让它们按统一大小的矩形排布到页面上。我写了以下代码可以在第1页中按照指定横向和纵向矩形数目，填充指定路径下的图片。

Sub LoadPicToShape()
    Dim mPageWidth As Double, mPageHeight As Double
    Dim X_Count As Integer, Y_Count As Integer
    Dim mShapeWidth As Double, mShapeHeight As Double
    Dim mShape As Shape
    Dim mPicPath As String, mPicName As String

    '清除所有第1页上的所有形状

    Do Until ActivePresentation.Slides(1).Shapes.Count = 0
        ActivePresentation.Slides(1).Shapes(1).Delete
    Loop

    mPageWidth = ActivePresentation.PageSetup.SlideWidth '获取页面宽度
    mPageHeight = ActivePresentation.PageSetup.SlideHeight '获取页面高度

    '这2个参数可以自己调整
    X_Count = 10: Y_Count = 6 'X方向图片数量，Y方向图片数量
    mShapeWidth = mPageWidth / X_Count: mShapeHeight = mPageHeight / Y_Count '图片形状的宽度和高度

    '指定图片所在文件夹路径，并开始获取第1张jpg图片名称
    mPicPath = "E:Office培训素材图片"
    mPicName = Dir(mPicPath & "*.jpg")
    If mPicName = "" Then Exit Sub

    '以下首先生成矩形形状，然后填充图片到形状
    For j = 1 To Y_Count
        For i = 1 To X_Count
            Set mShape = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, _
                (i - 1) * mShapeWidth, (j - 1) * mShapeHeight, mShapeWidth, mShapeHeight)
            mShape.Fill.UserPicture mPicPath & "" & mPicName
            mPicName = Dir
            If mPicName = "" Then mPicName = Dir(mPicPath & "*.jpg") '图片总数不够数，从头开始重复加载
        Next
    Next
End Sub