码迷,mamicode.com
首页 > 其他好文 > 详细

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

时间:2015-08-14 21:04:02      阅读:153      评论:0      收藏:0      [点我收藏+]

标签:

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

 1 Sub LoadPicToShape()
 2     Dim mPageWidth As Double, mPageHeight As Double
 3     Dim X_Count As Integer, Y_Count As Integer
 4     Dim mShapeWidth As Double, mShapeHeight As Double
 5     Dim mShape As Shape
 6     Dim mPicPath As String, mPicName As String
 7 
 8     清除所有第1页上的所有形状
 9 
10     Do Until ActivePresentation.Slides(1).Shapes.Count = 0
11         ActivePresentation.Slides(1).Shapes(1).Delete
12     Loop
13 
14     mPageWidth = ActivePresentation.PageSetup.SlideWidth 获取页面宽度
15     mPageHeight = ActivePresentation.PageSetup.SlideHeight 获取页面高度
16 
17     这2个参数可以自己调整
18     X_Count = 10: Y_Count = 6 X方向图片数量,Y方向图片数量
19     mShapeWidth = mPageWidth / X_Count: mShapeHeight = mPageHeight / Y_Count 图片形状的宽度和高度
20 
21     指定图片所在文件夹路径,并开始获取第1张jpg图片名称
22     mPicPath = "E:\Office培训\素材\图片"
23     mPicName = Dir(mPicPath & "\*.jpg")
24     If mPicName = "" Then Exit Sub
25 
26     以下首先生成矩形形状,然后填充图片到形状
27     For i = 1 To X_Count
28         For j = 1 To Y_Count
29             Set mShape = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, _
30                 (i - 1) * mShapeWidth, (j - 1) * mShapeHeight, mShapeWidth, mShapeHeight)
31             mShape.Fill.UserPicture mPicPath & "\" & mPicName
32             mPicName = Dir
33             If mPicName = "" Then mPicName = Dir(mPicPath & "\*.jpg") 图片总数不够数,从头开始重复加载
34         Next
35     Next
36 End Sub

 

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

标签:

原文地址:http://www.cnblogs.com/alexywt/p/4731149.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!