将Excel数据导入PowerPoint幻灯片-运行时错误'-2147024809（80070057）和#x27；：指定的值超出范围

我试图将Excel行中的数据加载到PowerPoint幻灯片中，但代码在最后一行中断并给出错误

“值超出范围”

这是我第一次使用VBA，所以我可能犯了一个非常愚蠢的错误，但我自己无法修复它

我正在使用这个网站上的脚本

我尝试过分解代码行，似乎错误是由.Textrange.Text部分引起的，但这在其他示例中使用得很好

打开Excel并加载值

WS.Cells（i，1）.Value

有效，我用

Msgbox（）

尝试了这个方法

因此，错误似乎在于选择和填充文本框/形状（本例中仅一个）。除了已经存在的普通文本框之外，我还通过开发者菜单添加了空文本框，并在选择窗格中重命名了它们

有人能告诉我我做错了什么吗

Sub ReferentieSlides()
    'Open the Excel workbook. Change the filename here.
    Dim OWB As New Excel.Workbook
    Set OWB = Excel.Application.Workbooks.Open("C:\Users\Me\File.xlsm")

    'Grab the first Worksheet in the Workbook
    Dim WS As Excel.Worksheet
    Set WS = OWB.Worksheets(1)

    'Loop through each used row in Column A
    For i = 1 To WS.Range("A10").End(xlUp).Row
        'Copy the first slide and paste at the end of the presentation
        ActivePresentation.Slides(1).Copy
        ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
        'Change the text of the first text box on the slide.
        ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value  
    Next
End Sub

到目前为止已尝试修复的代码：

#如果是VBA7，则
用于64位系统的公共声明PtrSafe子睡眠库“kernel32”（ByVal dwr作为LongPtr）
#否则
用于32位系统的公共声明子睡眠库“kernel32”（ByVal dwms长度相同）
#如果结束
子引用幻灯片（）
'打开Excel工作簿。在这里更改文件名。
将OWB设置为新的Excel.工作簿
'Set OWB=Excel.Application.Workbooks.Open（“C:\Users\IngeSchenk\Boer&Croon Management BV\Management Solutions-Bank\Macro references.xlsm”）
设置OWB=Excel.Application.Workbooks.Open（“C:\Users\IngeSchenk\Dropbox\Test2.xlsx”）
'获取工作簿中的第一个工作表
将WS设置为Excel.Worksheet
设置WS=OWB.工作表（1）
“定义我
我想我会坚持多久
'循环通过列A中使用的每一行
对于i=1到WS.Range（“A”&Rows.Count）.End（xlUp）.Row
'复制第一张幻灯片并粘贴到演示文稿末尾
ActivePresentation.幻灯片（1）.复制
ActivePresentation.Slides.Paste（ActivePresentation.Slides.Count+1）
“睡10秒钟
MsgBox“执行已开始”
睡眠延迟10000毫秒
MsgBox“执行已恢复”
'更改幻灯片上第一个文本框的文本。
ActivePresentation.Slides（ActivePresentation.Slides.Count）.Shapes（1）.TextFrame.TextRange.Text=WS.Cells（i，1）.Value
下一个
端接头

由于David Zemens对这是一个PPT宏的评论，我更改了这个答案。问题在于使用的End（xlup）函数在PPT中不起作用 这确实对我有用，但如果对你有用的话，可以用你的方式打开excel

Sub ReferentieSlides()
    'Open the Excel workbook. Change the filename here.
Dim OWB As Object
    Set OWB = CreateObject("T:\user\me\File.xlsm")

    'Grab the first Worksheet in the Workbook
    Set WS = OWB.Sheets(1)


Set PPTObj = ActivePresentation  'Get the presentation that was opened

    'Loop through each used row in Column A
    'For i = 1 To WS.Range("A10").End(xlUp).Row
    For i = 1 To WS.Range("A1:A10").CurrentRegion.Rows.Count
        'Copy the first slide and paste at the end of the presentation
        PPTObj.Slides(1).Copy
        PPTObj.Slides.Paste (PPTObj.Slides.Count + 1)
        'Change the text of the first text box on the slide.
        PPTObj.Slides(PPTObj.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
    Next
End Sub

---

由于David Zemens对这是一个PPT宏的评论，我改变了这个答案。问题在于使用的End（xlup）函数在PPT中不起作用 这确实对我有用，但如果对你有用的话，可以用你的方式打开excel

Sub ReferentieSlides()
    'Open the Excel workbook. Change the filename here.
Dim OWB As Object
    Set OWB = CreateObject("T:\user\me\File.xlsm")

    'Grab the first Worksheet in the Workbook
    Set WS = OWB.Sheets(1)


Set PPTObj = ActivePresentation  'Get the presentation that was opened

    'Loop through each used row in Column A
    'For i = 1 To WS.Range("A10").End(xlUp).Row
    For i = 1 To WS.Range("A1:A10").CurrentRegion.Rows.Count
        'Copy the first slide and paste at the end of the presentation
        PPTObj.Slides(1).Copy
        PPTObj.Slides.Paste (PPTObj.Slides.Count + 1)
        'Change the text of the first text box on the slide.
        PPTObj.Slides(PPTObj.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
    Next
End Sub

---

能否将

Debug.Print-ActivePresentation.Slides（ActivePresentation.Slides.Count）.Shapes.Count

放在

行下方的行上，粘贴
并查看返回到即时窗口的内容？另外，它是在循环的第一次迭代中中断的，还是在特定的一次迭代中中断的？Excel到PowerPoint是出了名的笨重，您可能只需要在循环中添加一些缓冲时间。（另外，请声明所有变量。在调用
i
之前，将
Dim i添加到sub
。此外，如果您在
A1:A10
中有信息，您的循环将从行
1
转到
1
…这就是您想要的吗？我想您想要
ws.Range（“A”&rows.count）.结束（xlUp）.Row
？@dwory该公式在该幻灯片上计算了12个形状。代码在第一次迭代时中断：创建了一张新幻灯片，但没有添加任何信息。在粘贴信息之前，我尝试添加了一个10秒的睡眠函数，但仍然显示错误。@BruceWayne在打开For循环之前，我还添加了
Dim I-Long
对ws.Range进行了调整以改进，但没有效果：（为什么您打开的Excel文件是启用宏的文件？它是否有运行的宏？是否可以放入
Debug.Print ActivePresentation.Slides（ActivePresentation.Slides.Count）中）.Shapes.Count
在您的
行下方的行上。粘贴
行，查看返回到即时窗口的内容。此外，它是在循环的第一次迭代时中断的，还是在特定的循环中中断的？Excel到PowerPoint是出了名的笨拙，您可能只需要在循环中添加一些缓冲时间。（另外，请声明所有变量。在调用
i
之前，将
Dim i添加到sub
。此外，如果您在
A1:A10
中有信息，您的循环将从行
1
转到
1
…这就是您想要的吗？我想您想要
ws.Range（“A”&rows.count）.结束（xlUp）.Row
？@dwory该公式在该幻灯片上计算了12个形状。代码在第一次迭代时中断：创建了一张新幻灯片，但没有添加任何信息。在粘贴信息之前，我尝试添加了一个10秒的睡眠函数，但仍然显示错误。@BruceWayne在打开For循环之前，我还添加了
Dim I-Long
调整了ws.Range以提高您的性能，但无效：（为什么您打开的Excel文件是启用宏的文件？它是否有运行的宏？OP的代码似乎是从PPT本机运行的，因此Excel.Application实例被实例化。否则，正如您所注意的，ActivePresentation上会有一个对象变量或With Block not set error。OP的代码似乎是从PPT本机运行的。）PPT，因此Excel.Application实例的实例化。否则，ActivePresentation上会出现对象变量或With Block not set error，正如您所注意到的。