[VBA] PPT/WPS演示 超级好用的形状（矩形）创建代码

ittech

这份代码，实现了PPT中矩形的批量创建，如果觉得好请为我点个赞，谢谢！

所有产品经理都离不开画架构图，最常用的形式就是下图这样由N个“形状”组成的，最常用的是矩形。
别问我为什么会在PPT中画，而不是用亿图这些软件，问就是为了让别人也能用（纯纯的牛马），




众所周知，PPT中只能手工一个一个的插入矩形，那么如果KC很多的情况下为了自己不被累死，在AI的协助下创作了这份代码，

[Visual Basic] 纯文本查看 复制代码

?

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54

Sub CreateRectanglesWithTextOnSingleSlide()     Dim pptApp As Application     Dim pptPres As Presentation     Dim pptSlide As Slide     Dim shp As Shape     Dim i As Integer     Dim rectWidth As Single     Dim rectHeight As Single     Dim list As Variant     Dim xPosition As Single     Dim yPosition As Single       ' 获取当前的PowerPoint应用程序、演示文稿和幻灯片     Set pptApp = Application     Set pptPres = ActivePresentation     Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank) ' 添加一个空白幻灯片       ' 定义列表     list = Array("第一行文字", "第二行文字", "第三行文字") ' 这里添加你的列表内容       ' 设置矩形的宽度和高度     rectWidth = 200     rectHeight = 50       ' 设置矩形的起始位置     xPosition = 50 ' X坐标起始位置     yPosition = 100 ' Y坐标起始位置       ' 循环遍历列表，并在同一页幻灯片上创建矩形和文本     For i = LBound(list) To UBound(list)         ' 创建矩形         Set shp = pptSlide.Shapes.AddShape(msoShapeRectangle, xPosition, yPosition, rectWidth, rectHeight)           ' 设置矩形的填充颜色为蓝色         shp.Fill.ForeColor.RGB = RGB(0, 0, 255) ' 蓝色背景           ' 设置矩形的边框为无         shp.Line.ForeColor.RGB = RGB(255, 255, 255) ' 白色边框，相当于无边框           ' 在矩形中添加文本         With shp.TextFrame             .TextRange.Text = list(i) ' 列表中对应的文本             .TextRange.Font.Color.RGB = RGB(255, 255, 255) ' 白色字体         End With           ' 更新矩形的X位置，以便下一个矩形水平排列         xPosition = xPosition + rectWidth + 20 ' 20是两个矩形之间的间距         ' 如果超出幻灯片宽度，重新设置xPosition并降低yPosition         If xPosition + rectWidth > pptSlide.Master.Width Then             xPosition = 50             yPosition = yPosition + rectHeight + 20         End If     Next i End Sub

现在只需要在Array("第一行文字", "第二行文字", "第三行文字") ' 这里添加你的列表内容，就可以自动生成这些矩形了，非常的人性。

moranyuyan

以下功能无法保存在未启用宏的演示文稿中:Visual Basic for Applications (BA)项目若要使保存的文件具有这些功能，请单击“否“返回“另存为"对话框，然后从“文件类型"列表中选择一个启用宏的文件类型,是否继续将此文件保存为未启用宏的演示文稿?

ittech

突然想到其实利用SmartArt，直接将文字列表转换成“基本列表”，再转换成形状，然后取消组合也能实现这个效果。
但WPS不支持，只能在PowerPoint里做。

19877130

看不到 但大为震撼

天天涨停天天盈

看不太懂，我选择手搓。。。。

xinyangtuina

留言支持。有成品就好了

linyufang

马上研究研究，谢谢分享！

SmallRadar

天天涨停天天盈 发表于 2024-8-6 10:19
看不太懂，我选择手搓。。。。

我也手搓+1，还是关注研究下工具

ittech

天天涨停天天盈 发表于 2024-8-6 10:19
看不太懂，我选择手搓。。。。

ppt里alt+F11创建一个模块，代码复制进去运行即可。

zt041512

谢谢楼主分享，楼主辛苦了！

xueyinglantian

谢谢分享哈，看起来很厉害

ssh66888

能成功实现楼主最后一张图，然后改改那几个字，别的不会了，怎么实现第一张图那种效果？