Ошибка выполнения VBA -2147188720 Объект не существует - PullRequest
Новая
       11

Ошибка выполнения VBA -2147188720 Объект не существует

0 голосов
/ 04 февраля 2019

Я пытаюсь запустить код VBA через Excel, который создает несколько файлов PowerPoint, используя цикл.Тем не менее, я получаю ошибку времени выполнения каждый раз, когда цикл увеличивается.Ошибка появляется, когда myshape.LockAspectRatio = False выполняется для любой итерации после первой.

Я также получаю

ошибка времени выполнения -2147188160 - 'Фигуры (неизвестный элемент): неверный запрос

при выполнении ppslide.Shapes.PasteSpecial ppPasteEnhancedMetafile.Это происходит в случайное время во время выполнения.

Вот что я пытаюсь сделать: exec_sorted - это словарь коллекции 

For Each iter1 In accExec_sorted.Keys()

    Set ppapp = New PowerPoint.Application
    Set pppress = ppapp.Presentations.Add
    pppress.PageSetup.SlideSize = ppSlideSizeLetterPaper
    Set ppslide = pppress.Slides.Add(1, ppLayoutTitle)
    ppslide.Shapes(1).TextFrame.TextRange = iter1

    i = 2
    Set lenderID = accExec_sorted(iter1)

    For Each iter In lenderID
        ind_len.Range("l_id1") = iter
        Set ppslide = pppress.Slides.Add(i, ppLayoutBlank)


        ind_len.ChartObjects("Chart 6").Select
        Selection.Copy
        ppslide.Shapes.PasteSpecial ppPasteEnhancedMetafile
        Set myshape = ppslide.Shapes(1)
        myshape.LockAspectRatio = False

        myshape.Left = 420
        myshape.Top = 40
        myshape.Width = 290
        myshape.Height = 160

        ind_len.ChartObjects("Chart 7").Select
        Selection.Copy
        ppslide.Shapes.PasteSpecial ppPasteEnhancedMetafile
        Set myshape = ppslide.Shapes(2)
        myshape.LockAspectRatio = False

        myshape.Left = 420
        myshape.Top = 205
        myshape.Width = 290
        myshape.Height = 160


        i = i + 1

    Next iter

    pppress.SaveAs intro.Range("dest_path") & intro.Range("investor") & "_" & intro.Range("period") & "_" & iter1 & ".pptx"
    pppress.Close
    ppapp.Quit
    Set ppapp = Nothing

Next iter1

1 Ответ

0 голосов
/ 04 февраля 2019

ОК, Шрейанс, мне пришлось изменить код, чтобы он работал на моем конце и поиграл с некоторыми вещами, но это работает.Затем я вставил ваш код в то, что у меня есть.Проблема заключалась в том, что вы пытались вставить в презентацию chartobject как объект, а не копировать объект как изображение.Как только я сделал это и установил объекты на ничто, это работало.Вот мой код.

ПРИМЕЧАНИЕ. Вы можете изменить его обратно на использование переменной Powerpoint.Application без использования объекта create.Я просто сделал это, чтобы мне было легче. 

Sub CopyPastePicture()

    For Each iter1 In accExec_sorted.Keys()

        Set ppapp = CreateObject("PowerPoint.Application")
        Set pppress = ppapp.Presentations.Add
        pppress.PageSetup.SlideSize = 2
        Set ppslide = pppress.Slides.Add(1, 1)
        ppslide.Shapes(1).TextFrame.TextRange = iter1

        i = 2
        Set lenderID = accExec_sorted(iter1)

        For Each iter In lenderID
            ind_len.Range("l_id1") = iter

            Set ppslide = pppress.Slides.Add(i, 12)

            ind_len.ChartObjects("Chart 6").CopyPicture xlPrinter, xlPicture
            ppslide.Shapes.PasteSpecial 2
            Set myshape = ppslide.Shapes(ppslide.Shapes.Count)

            myshape.LockAspectRatio = False

            myshape.Left = 420
            myshape.Top = 40
            myshape.Width = 290
            myshape.Height = 160

            Set myshape = Nothing

            ind_len.ChartObjects("Chart 7").CopyPicture xlPrinter, xlPicture
            ppslide.Shapes.PasteSpecial 2
            Set myshape = ppslide.Shapes(ppslide.Shapes.Count)

            myshape.LockAspectRatio = False

            myshape.Left = 420
            myshape.Top = 205
            myshape.Width = 290
            myshape.Height = 160

            Set myshape = Nothing
            Set ppslide = Nothing

            i = i + 1

        Next iter

        pppress.SaveAs intro.Range("dest_path") & intro.Range("investor") & "_" & intro.Range("period") & "_" & iter1 & ".pptx"
        pppress.Close
        ppapp.Quit
        Set ppapp = Nothing
        Set pppress = Nothing
        Set ppslide = Nothing
        Set myshape = Nothing

    Next iter1

End Sub
...