EXCEL表格内容自动提取，并填充到新建的PPT页面中

etkane

代码如下，按需更改：）

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

Sub 提取EXCEL内容到PPT()

Dim ptApp As Object
Set ptApp = CreateObject("PowerPoint.Application")
Dim ppts As Presentations
Set ppts = ptApp.Presentations
Debug.Print (ppts(1).Application)
Dim ppt As Presentation
Set ppt = ppts(1)
Dim pptsd As Slide
Dim pptsds As Slides


'Debug.Print (ppt.Slides.Count())    'Set pptlayout = ppt.Slides(1).CustomLayout    'Debug.Print (pptlayout.Name)
 Dim i As Integer
 
 
 

 For i = 7 To 8
 
   '加一页
    Set pptsds = ppt.Slides
    Set pptsd = ppt.Slides.AddSlide(ppt.Slides.Count() + 1, ppt.SlideMaster.CustomLayouts(3)) '根据实际调整母版
     
    pptsds(ppt.Slides.Count()).Select
    Set pptsd = pptsds(pptsds.Count())
    
    
     '增加文本框及文本，增加名称
    Set TextRange = pptsd.Shapes.AddTextbox(1, 50, 55, ppt.SlideMaster.Width - 100, 50)
        TextRange.Name = "原始信息"
        With TextRange.TextFrame.TextRange
            .Text = "6_ " & Cells(i, 6) & "4_ " & Cells(i, 4) & "9_ " & Cells(i, 9) & "8_ " & Cells(i, 8) & " /10_ " & Cells(i, 10) & " /11_ " & _
            Cells(i, 11) & " /12_ " & Cells(i, 12) & " /13_ " & Cells(i, 13) & "_提出" _
            & " / 15变更单号：" & Cells(i, 15) & " / 16单据：" & Cells(i, 16) & Chr(10) _
            & "14变更原因： " & Cells(i, 14) & _
             " / 17变更依据： " & Cells(i, 17) & Chr(10) _
            & "18工程项目内容描述：" & Cells(i, 18) & Chr(10) _
            & "21原造价： " & Int(Cells(i, 21)) & " / 22现造价： " & Int(Cells(i, 22)) & " / 23增减金额： " & Int(Cells(i, 23)) & " / 23报价书出处： " & Cells(i, 24) & Chr(10) _
            & "25说明：" & Cells(i, 25) & Chr(10) _
            & "26备注：" & Cells(i, 26) & "/27需求提出时间：" & Cells(i, 27) & "/28完成时间：" & Cells(i, 28) & "/29签证时间：" & Cells(i, 29)
                     
             .Font.Size = 14
        End With
    pptsd.Shapes("标题 1").TextFrame.TextRange.Text = "变更单号：" & Cells(i, 15) & " ， " & Cells(i, 14)
   
   '加分割线线
   
   ypoint = pptsd.Shapes("原始信息").Top + pptsd.Shapes("原始信息").Height
    
    With pptsd.Shapes.AddLine(50, ypoint, ppt.SlideMaster.Width - 50, ypoint).Line
        .DashStyle = msoLineLongDash
        .ForeColor.RGB = RGB(144, 202, 249)
        .Weight = 2
        
    End With
    
  Next i
  

End Sub

etkane

mjlzyy 发表于 2024-9-7 21:44
哪位大神可以详细点讲下，如何使用以上代码？求求了 非常想学习下

这玩意的原理就是
按母板新建一页，
创建或者修改图形里的文本，
从excel一行里提取数据，拼装，放到新建的ppt页及对应区域。
新建下一页(对应excel下一行)

领导让我分析，那excel几百行几十列，公司电脑屏太小，看不过来，做了这个东西，把每行改每页，好看。然后写意见也好汇报。

etkane

alice2wu 发表于 2024-9-8 10:43
可以将图片地址放到excel里面，然后替换掉PPT里面相应的图片吗？

可以的，原理一样，不过PPT的对象类型要改一下。我也是边用边写，你可以查一下PPT shape类型里面的图片类型，应该属于SHAPE，具体微软网站。

wobzhidao

请问WPS的可以用吗

etkane

wobzhidao 发表于 2024-9-7 16:57
请问WPS的可以用吗

应该可以，就是很多excel数据，规律放到ppt上用，这只是个引子，根据需要自己改就好。

etkane

最好只打开对应表格和ppt，起码两个界面都是激活的界面，也可以手动写目录指定。

清淡如风

支持一下，学习中。

afti

自动提取表格内容还是很方便的

fhlfxtd

支持一下，学习中。

song20240721

感谢分享

luxvn

支持一下，学习中

dylyh

学习中，感谢分享～