Excel 到 PowerPoint VBA 循环

Question

首先，我不擅长 VBA，老实说，我不知道如何解决这个问题。

情况

我有一个如下所示的数据库，其中包含多个条目（目前只有 2 个，但随着学生的工作进展，会有更多条目）。我希望能够过滤数据库，然后根据选择将信息放入 PowerPoint 幻灯片中。

我创建了（有很多 youtube 视频）一个脚本，它将相关信息从一行复制到 PowerPoint 演示文稿中定义的字段中。

问题

我完全不知道如何循环该代码以便仅将过滤后的信息带入 PowerPoint。有人可以指导我如何去做吗？

Sub XLS_to_PPT()
    Dim pptPres As Presentation
    Dim strPfad As String
    Dim strPOTX As String
    Dim pptApp As Object
        
    strPfad = "C:XXX"
    strPOTX = "PPT_Template.pptx"
        
    Set pptApp = New PowerPoint.Application
        
    pptVorlage = strPfad & strPOTX
        
    pptApp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue
        
    Set pptPres = pptApp.ActivePresentation
        
    pptPres.Slides(1).Duplicate
    pptPres.Slides(1).Select
    pptPres.Slides(1).Shapes("Header").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(5, 5).Value
    pptPres.Slides(1).Shapes("ClientChanlenge").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(5, 9).Value
    pptPres.Slides(1).Shapes("HowWeHelped").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(5, 10).Value
        
    pptPres.SaveAs strPfad & ("New_Request")
        
    pptPres.Close
        
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub

Answer 1

我想，计划是为表格中的每个可见行创建一张新幻灯片。 所以你可以像这样遍历表格：

For Each tableRow In Sheets("NameOfYourSheet").ListObjects("NameOfYourTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
    set newSlide = pptPres.Slides(1).Duplicate
    newSlide.Shapes("Header").TextFrame.TextRange.Characters.Text = tableRow.Columns(5).Value
    newSlide.Shapes("ClientChanlenge").TextFrame.TextRange.Characters.Text = tableRow.Columns(9).Value
    newSlide.Shapes("HowWeHelped").TextFrame.TextRange.Characters.Text = tableRow.Columns(10).Value
Next tableRow

基本上，我们遍历表格中的每一行，复制幻灯片 (1)，使用新的幻灯片对象按给定的列号填充其中的形状。
SpecialCells(xlCellTypeVisible) 负责忽略过滤掉的行。

Answer 2

尝试查看this answer.

这里描述了如何循环过滤列表。那里有信息如何获取您正在循环的单元格的地址等等

编辑：在我受到谴责后，我发布了完整的解决方案。希望它有效。 edit2：现在它可以用于任意数量的幻灯片

Sub XLS_to_PPT()

Dim pptPres As Presentation
Dim strPfad As String
Dim strPOTX As String
Dim pptApp As Object

    
    strPfad = "C:XXX"
    strPOTX = "PPT_Template.pptx"
    
    Set pptApp = New PowerPoint.Application
    
    
    pptVorlage = strPfad & strPOTX
    
    pptApp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue
    
    
    Set pptPres = pptApp.ActivePresentation
    'below if set the range to 500 but you may want to increase /decrease that number depending on how many entries you expecty
    Set rng = Range("A5:A500")
    
  For Each cl In rng.SpecialCells(xlCellTypeVisible)
        
    set mynewslide=pptPres.Slides(1).Duplicate
    
    
    ' I do not think you need below line
    'pptPres.Slides(1).Select
    
    mynewslide.Shapes("Header").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(cl.row, 5).Value
    mynewslide.Shapes("ClientChanlenge").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(cl.row, 9).Value
    mynewslide.Shapes("HowWeHelped").TextFrame.TextRange.Characters.Text = Worksheets("PPT_Creation").Cells(cl.row, 10).Value
    
        
    Next cl
  
    pptPres.SaveAs strPfad & ("New_Request")
     
    pptPres.Close
    
    Set pptPres = Nothing
    Set pptApp = Nothing

End Sub