如何用Excel指定区域数据填充PowerPoint表格？VBA代码问题求助

我的Excel文件中，Reports工作表的A40-G1330区域内，实际有效数据仅到A40-G63（其余区域因使用IFERROR公式显示为空）。需要将该工作表中D40-E63区域的数据，填充到已存在的PowerPoint文件（路径：C:\Users\habinalshaikh\Desktop\Training\presentation maker\Course Report.pptx）第3页名为“Table 1”的表格中。但我编写的VBA代码在统计有效行数和填充表格的逻辑上无法正常运行，原代码如下：

Dim Name_Attendees_lastVal As Range
Dim sht As Worksheet 
Dim pptapp As PowerPoint.Application
Dim presentation As PowerPoint.presentation
Dim ppslide As PowerPoint.Slide
Dim slidetitle As String
Dim pptfile As String
Dim slideCtr As Integer
Set sht = Sheets("Reports")
Set Name_Attendees_lastVal = sht.Columns(5).Find("*", sht.Cells(1, 2), xlValues, xlPart, xlByColumns,xlPrevious)
sht.Range("D40", Name_Attendees_lastVal).Resize(, 2).Select
pptfile = "C:\Users\habinalshaikh\Desktop\Training\presentation maker\Course Report.pptx" 
Set pptapp = CreateObject("PowerPoint.Application")
pptapp.Visible = True 
pptapp.Presentations.Open (pptfile)
 for i = 40 to Set Name_Attendees_lastVal = sht.Columns(5).Find("*", sht.Cells(1, 2), xlValues, xlPart, xlByColumns, xlPrevious).count  ' this code is to count the number of rows, but it doesn't work
 pptapp.ActivePresentation.Slides(3).Shapes("Table 1").TextFrame.TextRange.Characters.Text = ThisWorkbook.Sheets("Reports").Range("D"&i)   ' this code is to fill the table which is in the PowerPoint file with the names in the excel sheet
next
 for y = 40 to Set Name_Attendees_lastVal = sht.Columns(5).Find("*", sht.Cells(1, 2), xlValues, xlPart, xlByColumns, xlPrevious).count  ' this code is to count the number of rows, but it doesn't work
  pptapp.ActivePresentation.Slides(3).Shapes("Table 1").TextFrame.TextRange.Characters.Text = ThisWorkbook.Sheets("Reports").Range("E"&i)' this code is to fill the table which is in the PowerPoint file with the Attending status in the excel sheet
next

• 循环语法完全错误：for i = 40 to Set ...不符合VBA语法规则，无法正确获取循环边界
• 重复执行Find操作，冗余且降低代码效率
• PPT表格操作逻辑错误：直接给TextFrame.TextRange赋值会覆盖整个表格内容，而非逐单元格填充；第二个循环使用变量y但赋值时仍引用i，导致变量混淆
• 有效行定位不准确：原Find方法的起始位置和参数设置有误，无法稳定定位到公式返回空值区域前的最后一行有效数据

Sub FillPPTTable()
    Dim sht As Worksheet
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.Slide
    Dim pptTable As PowerPoint.Table
    Dim lastRow As Long
    Dim dataRange As Range
    Dim i As Long
    
    ' 定位Excel中的有效数据范围
    Set sht = ThisWorkbook.Sheets("Reports")
    ' 从E列底部向上查找最后一个非空单元格（自动忽略IFERROR返回的空值）
    lastRow = sht.Cells(sht.Rows.Count, "E").End(xlUp).Row
    ' 确保起始行不小于40
    lastRow = IIf(lastRow < 40, 40, lastRow)
    Set dataRange = sht.Range("D40:E" & lastRow)
    
    ' 打开目标PowerPoint文件
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Open("C:\Users\habinalshaikh\Desktop\Training\presentation maker\Course Report.pptx")
    Set pptSlide = pptPres.Slides(3)
    ' 获取PPT中的目标表格对象
    Set pptTable = pptSlide.Shapes("Table 1").Table
    
    ' 逐单元格填充数据（PPT表格行号从1开始）
    For i = 1 To dataRange.Rows.Count
        pptTable.Cell(i, 1).Shape.TextFrame.TextRange.Text = dataRange.Cells(i, 1).Value
        pptTable.Cell(i, 2).Shape.TextFrame.TextRange.Text = dataRange.Cells(i, 2).Value
    Next i
    
    ' 释放对象，避免内存泄漏
    Set pptTable = Nothing
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    Set dataRange = Nothing
    Set sht = Nothing
End Sub

• 有效数据定位：使用End(xlUp)从列底部向上查找，比Find更稳定，能自动跳过IFERROR返回的空值行
• PPT表格操作：直接获取Table对象，通过Cell(row, col)逐单元格赋值，避免覆盖整个表格内容
• 循环逻辑：基于Excel有效数据的行数循环，对应PPT表格的行号（PPT表格行号从1开始，与Excel数据行偏移对应）
• 对象清理：手动释放所有对象变量，避免长期运行导致的内存占用问题

内容的提问来源于stack exchange，提问作者Abu Ali