Question

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

“值超出范围”。

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

我正在使用此站点中的脚本 https://www.craig-tolley.co.uk/2011/06/08/vba-create-powerpoint-slide-for-each-row-in-excel-workbook/

我尝试破坏代码行，并且似乎错误是由.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

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

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub ReferentieSlides()


'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
'Set OWB = Excel.Application.Workbooks.Open("C:\Users\IngeSchenk\Boer & Croon Management BV\Management Solutions - Bank\Macro Referenties.xlsm")
Set OWB = Excel.Application.Workbooks.Open("C:\Users\IngeSchenk\Dropbox\Test2.xlsx")

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

'Define i
Dim i As Long

'Loop through each used row in Column A
For i = 1 To WS.Range("A" & Rows.Count).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)

    'Sleep for 10sec
    MsgBox "Execution is started"
    Sleep 10000 'delay in milliseconds
    MsgBox "Execution Resumed"

    '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

Answer 1

由于David Zemens对这是一个PPT宏的评论，所以我更改了此答案。问题是使用了在PPT中不起作用的End（xlup）函数这确实对我有用，但是如果可以，打开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

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

1 个答案: