如何把excel表格中的内容批量导入PPT中?
用PowerPoint做一个多页的PPT。用VBA可以根据excel数据在PPT里批量添加图片和文本,结合文心一言、chatglm、通义千问生成的批处理代码,非常方便。通义的代码生成能力最强!!!
- Sub PPT批量插入幻灯片文本框()
-
- Dim pptPre As Presentation
- Dim p, C As Long
- Dim n As Integer
- Dim myPath As String
- Dim appExcel As Object
- Dim myexcel As Object
- Dim mysheet As Object
- Dim rcount As Long
- Dim txtBoxWidth As Integer
- Dim txtBoxHeight As Integer
-
- Set pptPre = ActivePresentation
-
-
-
- Set appExcel = CreateObject("Excel.Application") '创建excel对象
- Set myexcel = appExcel.Workbooks.Open("C:\Users\hw\Desktop\元旦.xlsx") '打开工作表
- Set mysheet = myexcel.sheets("Sheet1") '创建工作表对象
- rcount = mysheet.Cells(mysheet.Rows.Count, "A").End(3).Row '获取工作表最后一行行号
-
- txtBoxWidth = 800 '文本框宽度
- txtBoxHeight = 70 '文本框高度
-
- For p = 2 To rcount '从第2行到最后一行
- ActivePresentation.Slides(1).Copy '复制第一张幻灯片
- ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1) '粘贴至最后一张之后
-
- For C = 2 To 4 '循环插入文本框
- With ActivePresentation.Slides(ActivePresentation.Slides.Count)
- With .Shapes.AddTextbox(msoTextOrientationHorizontal, 75, -100 + C * (txtBoxHeight + 50), txtBoxWidth, txtBoxHeight) '文本框坐标及长宽
- .TextFrame.TextRange.Font.Color = vbYellow '字体颜色
- .TextFrame.TextRange.Font.Size = 20 '字号
- .TextFrame.TextRange.Text = mysheet.Cells(p, C).Value '文本内容
- .TextFrame2.TextRange.ParagraphFormat.Alignment = ppAlignCenter '文本内容水平居中
-
- End With
- End With
- Next C
- Next p
-
- myexcel.Close
-
- Set pptPre = Nothing
- Set appExcel = Nothing
- Set myexcel = Nothing
- Set mysheet = Nothing
- End Sub