Динамическое копирование из Excel на несколько отформатированных слайдов Powerpoint

Question

Помощь!Я новичок в VBA и пытаюсь получить приведенный ниже макрос для копирования ячеек из листа Excel на слайды PowerPoint, а затем переформатировать скопированные ячейки, чтобы они более эффективно соответствовали PowerPoint.Код ниже работает иногда, но не другие.Вот ошибка, которую я продолжаю получать:

"Shapes.PasteSpecial: недопустимый запрос. Буфер обмена пуст или содержит данные, которые не могут быть вставлены сюда."

Любая помощь в очистке этого кода и получении егофункционал искренне, искренне ценится.

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Dim i As Integer
Dim r As Integer
Dim s As Integer
Dim Restart As String

i = 0
r = 26

'Copy Range from Excel
  Set rng = ThisWorkbook.ActiveSheet.Range("B2:Y25")

'This helps my macro loop through to repeat the build for multiple ppt slides
Restart:
Do Until i = 19


'Create an Instance of PowerPoint
  On Error Resume Next

 'Is PowerPoint already opened?
  Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
  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

'Optimize Code
  Application.ScreenUpdating = False

'Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(2, 11) '11 = ppLayoutTitleOnly


'Copy Excel Range
  rng.Offset(r * i, 0).Copy


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

'Set position:
  myShape.Left = 10
  myShape.Top = 45

'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False

Dim myPic As Object
Dim NewWidth As Long
Dim NewHeight As Long

'Set Obj Variable equal to Current Selected Object
    On Error GoTo Select_Object
    Set myPic = myShape
    On Error GoTo 0

'Resize width and height
    myPic.Width = myPic.Width + 65
    myPic.Height = myPic.Height + 85

 i = i + 1

 GoTo Restart

Exit Sub

'Error Handler In Case No Object is Currently Selected
 Select_Object:
 MsgBox "No object selected to center."

 Loop

 End Sub