这份代码，实现了PPT中矩形的批量创建，如果觉得好请为我点个赞，谢谢！
所有产品经理都离不开画架构图，最常用的形式就是下图这样由N个“形状”组成的，最常用的是矩形。
别问我为什么会在PPT中画，而不是用亿图这些软件，问就是为了让别人也能用（纯纯的牛马），
众所周知，PPT中只能手工一个一个的插入矩形，那么如果KC很多的情况下为了自己不被累死，在AI的协助下创作了这份代码，
[Visual Basic] 纯文本查看 复制代码 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("第一行文字", "第二行文字", "第三行文字") ' 这里添加你的列表内容，就可以自动生成这些矩形了，非常的人性。
| 
[复制链接]
发表于 2024-8-6 09:58
|
发表于 2024-8-8 16:34
还是关注研究下工具
