Активная ошибка X 429 не может создать объект, когда я пытаюсь запустить приведенный ниже макрос

Question

Итак, я пытаюсь создать макрос, который будет копировать данные из таблицы Excel (в данном случае «Регионы»), а затем скопировать вставку в существующий шаблон PowerPoint, слайд № 4.

Пожалуйстаобратите внимание, что PowerPoint и файл Excel сохраняются в папке Dropbox.(если это что-то меняет) Я не специалист по VBA, поэтому не могу понять, почему он показывает мне эту ошибку.

Код ниже:

Sub excelrangetopowerpoint()

Dim rng As Range
Dim powerpointapp As Object
Dim mypresentation As Object
Dim destinationPPT As String
Dim myshape As Object
Dim myslide As Object

Set rng = Worksheets("regions").Range("B1:N18")

On Error Resume Next

Set powerpointapp = CreateObject("powerpoint.application")
detinationppt = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
PowerPoint.Presentations.Open (destinationPPT)

On Error GoTo 0

Application.ScreenUpdating = False

Set mypresentation = PowerPoint.ActivePresentation
Set myslide = mypresentation.Slides(4)

rng.Copy

myslide.Shapes.PasteSpecial DataType:=2 '2 = enhanced metafile
Set myshape = myslide.Shapes(myslide.Shapes.Count)

myshape.Left = 152
myshape.Top = 152

powerpointapp.Visible = True
powerpointapp.Activate

Application.CutCopyMode = False

End Sub

Answer 1

В вашем коде две неопределенные переменные

detinationppt вместо destinationppt
Вы назначаете объект приложения PowerPoint для powerpointapp, но через 2 строки вы получаете доступ к (неопределенному) объектуPowerPoint

Вы можете легко избежать таких ошибок, поставив Option Explicit вверху кода.

Следующее, что вы можете назначить открытую презентацию, а не получить доступ к ActivePresentation,Я сделал тест, и для меня не удалось получить доступ к ActivePresentation.

И, пожалуйста, не вставляйте On Error resume Next в свой код, если вы точно не знаете, что делаете.Если вы хотите избежать ошибки времени выполнения, так как Powerpoint не может быть запущен, вы должны самостоятельно обработать ошибку (как это делается вашим «кодом, который работает нормально»).Для начала просто удалите его.

Этот код работал для меня (конечно, с другим именем файла)

Set powerpointApp = CreateObject("powerpoint.application")
destinationPPT = C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx    
Set myPresentation = powerpointApp.Presentations.Open(destinationPPT)
Set mySlide = myPresentation.Slides(4)
(...)

Answer 2

Сначала добавьте эту строку в начало вашего модуля, как самый первый текст в целом:

Option Explicit

Затем в строке меню нажмите «Отладка» и «Скомпилировать проект VBA»

Вы получите серию сообщений об ошибках, например:

Ошибка компиляции:

Переменная не определена

Ипеременная, которая не была определена, будет выбрана для вас VBA.Большинство из них, похоже, опечатки, такие как

• detinationppt = ("C: вместо destinationPPT = ("C:
• PowerPoint.Presentations.Open (destinationPPT) вместо PowerPointApp.Presentations.Open (destinationPPT)
• Set mypresentation = PowerPoint.ActivePresentationвместо Set mypresentation = PowerPointApp.ActivePresentation

По сути, похоже, что вы скопировали и вставили 2 разных блока кода вместе и забыли проверить, совпадают ли все имена переменных (также, кажется, что Раннее связывание, а другое - Позднее связывание )

Если перейти к «Инструменты»> «Параметры ...»> «Редактор», появится флажок «Требовать объявление переменной»,Включите, оставьте это включенным и регулярно используйте опцию «Компилировать проект VBA» для проверки на наличие опечаток и похожих ошибок.

Answer 3

Вот код, который работает нормально:

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Range to copy
Set rng = Worksheets("regions").Range("B1:N18")

On Error Resume Next

Set PowerPointApp = GetObject(class:="PowerPoint.Application")

Err.Clear

'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If

On Error GoTo 0

Application.ScreenUpdating = False

'To create new presentation
Set myPresentation = PowerPointApp.Presentations.Add
'to add new slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

rng.Copy

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

myShape.Left = 152
myShape.Top = 152

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False

End Sub