Импорт данных Excel в слайды PowerPoint - ошибка времени выполнения '-2147024809 (80070057)': указанное значение выходит за пределы диапазона - PullRequest
Новая
       24

Импорт данных Excel в слайды PowerPoint - ошибка времени выполнения '-2147024809 (80070057)': указанное значение выходит за пределы диапазона

1 голос
/ 26 марта 2019

Я пытаюсь загрузить данные из строк Excel в слайды PowerPoint, но код разрывается на последнюю строку и выдает ошибку

«Значение вне диапазона».

Это первый раз, когда я работаю с VBA, поэтому, возможно, я делаю действительно глупую ошибку, но не могу исправить ее самостоятельно.

Я используюскрипт с этого сайта https://www.craig -tolley.co.uk / 2011/06/08 / vba-create-powerpoint-слайд-для-каждой-строки-в-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

1 Ответ

0 голосов
/ 12 апреля 2019

Из-за комментария Дэвида Земенса о том, что это макрос 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
...