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

来源：互联网发布：巨人网络客服中心编辑：程序博客网时间：2024/05/16 05:49

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

Sub LoadPicToShape()Dim mPageWidth As Double, mPageHeight As DoubleDim X_Count As Integer, Y_Count As IntegerDim mShapeWidth As Double, mShapeHeight As DoubleDim mShape As ShapeDim mPicPath As String, mPicName As String'清除所有第1页上的所有形状Do Until ActivePresentation.Slides(1).Shapes.Count = 0ActivePresentation.Slides(1).Shapes(1).DeleteLoopmPageWidth = 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 i = 1 To X_CountFor j = 1 To Y_CountSet mShape = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, _(i - 1) * mShapeWidth, (j - 1) * mShapeHeight, mShapeWidth, mShapeHeight)mShape.Fill.UserPicture mPicPath & "\" & mPicNamemPicName = DirIf mPicName = "" Then mPicName = Dir(mPicPath & "\*.jpg") '图片总数不够数，从头开始重复加载NextNextEnd Sub

0 0