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().Shapes.Count =

         ActivePresentation.Slides().Shapes().Delete

     Loop

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

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

     '这2个参数可以自己调整

     X_Count = : Y_Count =  '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 =  To Y_Count

         For i =  To X_Count

             Set mShape = ActivePresentation.Slides().Shapes.AddShape(msoShapeRectangle, _

                 (i - ) * mShapeWidth, (j - ) * mShapeHeight, mShapeWidth, mShapeHeight)

             mShape.Fill.UserPicture mPicPath & "\" & mPicName

             mPicName = Dir

             If mPicName = "" Then mPicName = Dir(mPicPath & "\*.jpg") '图片总数不够数，从头开始重复加载

         Next

     Next

 End Sub