网站 › 『编程语言区』 › [VBA] PPT/WPS演示 超级好用的形状（矩形）创建代码

ittech 发表于 2024-8-6 09:58

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

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

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


https://help-static-aliyun-doc.aliyuncs.com/assets/img/zh-CN/3665318261/p301554.png

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


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 发表于 2024-8-7 09:49

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

ittech 发表于 2024-8-8 16:34

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

19877130 发表于 2024-8-6 10:06

看不到 但大为震撼

天天涨停天天盈 发表于 2024-8-6 10:19

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

xinyangtuina 发表于 2024-8-6 10:20

留言支持。有成品就好了

linyufang 发表于 2024-8-6 10:21

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

SmallRadar 发表于 2024-8-6 10:22

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

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

ittech 发表于 2024-8-6 10:22

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

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

zt041512 发表于 2024-8-6 10:34

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

xueyinglantian 发表于 2024-8-6 10:55

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

ssh66888 发表于 2024-8-6 11:01

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

查看完整版本: [VBA] PPT/WPS演示 超级好用的形状（矩形）创建代码