Активная ошибка 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

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

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 2

У вас есть две неопределенные переменные в вашем коде

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 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