在PPT文本框中复制和粘贴单元格

Question

我想知道是否有人可以帮助我编写特定范围内的代码（例如A2-A5），它在PPT上的文本框中复制并粘贴了第一个单元格A2，然后将其复制到A3，并将其复制并粘贴到PPT中的另一个TXTBOX，依此类推，直到最后一行。

我写了此代码，但这仅在PPT上的一个文本框中复制整个范围A2-A5： Sub OpenPoints（）

Dim PPT As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim sl As PowerPoint.Slide
Dim sh As PowerPoint.Shape
Dim sh1 As PowerPoint.Shape
Dim r As Range
Dim filterRange As Range
Dim copyRange As Range
Dim lastRow As Long


'Open Powerpoint

Set PPT = New PowerPoint.Application
Set pres = PPT.Presentations.Open(ThisWorkbook.Path & "\Edenred_ProjectStatus_Saxo.pptx")

'Insert open points description
Set sl = pres.Slides(1)
Set sh1 = sl.Shapes("Rectangle 40")



'Filtra per "Y"

ThisWorkbook.Sheets("Action&Open_Point").Range("H1").AutoFilter field:=1, Criteria1:="Y"

'Individuazione ultima riga
lastRow = ThisWorkbook.Sheets("Action&Open_Point").Range("D" & 
ThisWorkbook.Sheets("Action&Open_Point").Rows.Count).End(xlUp).Row

'Copia colonna descrizione
Set copyRange = ThisWorkbook.Sheets("Action&Open_Point").Range("D2:D" & lastRow)
ActiveWorkbook.Worksheets("Action&Open_Point").UsedRange.Font.Underline = False
copyRange.SpecialCells(xlCellTypeVisible).Copy


sh1.TextFrame2.TextRange.PasteSpecial msoClipboardFormatRTF

预先感谢您的帮助！