Hi. I'm having some trouble with a macro that copies two ranges from excel and paste it into Powerpoint.
I have a sheet where you can enter a value and the plots on the sheet is updated.
A macro is run automatically when the value changes.
The vba to copy to powerpoint loops through several values and the sheet is updated, "automatic" macro run and the ranges are copied to powerpoint.
It works fine for some iterations, and then randomly it gives the error:
"Run-time error '1004': CopyPicture method of Range class failed
I tried changing CopyPicture to Copy, but then I just get the error:
"Shapes.PasteSpecial: Invalid request. The specified data type is unavailable."
I have a feeling it could either not be done calculating, or the automatic macro is not done in the background?
It does not happen at a specific value, but seems random each time.
The VBA is below. Would greatly appreaciate any help.
Sub ExcelRangeToPowerPoint()
Dim Plotsrng As Range
Dim perfrng As Range
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
Set myPresentation = PowerPointApp.Presentations.Add
PowerPointApp.Visible = True
PowerPointApp.Activate
Set Plotsrng = ThisWorkbook.Sheets("Producer").Range("E1:Z45")
Set perfrng = ThisWorkbook.Sheets("Producer").Range("L49:AC63")
well_list_range = Sheets("ProducerData").Range("Producer_well_list")
Application.Calculation = xlCalculateManual
For Each objName In well_list_range
Sheets("Producer").Range("C4").Value = objName
Application.Calculate
If Not Application.CalculationState = xlDone Then
DoEvents
End If
DoEvents
Debug.Print objName
SlideCount = myPresentation.Slides.Count
Set mySlide = myPresentation.Slides.Add(SlideCount + 1, 11) '11 = ppLayoutTitleOnly
Header1 = ThisWorkbook.Sheets("ProducerData").Range("G1")
Set myTitle = mySlide.Shapes.Title
myTitle.TextFrame.TextRange.Characters.Text = Header1
perfrng.CopyPicture
Set myShape = mySlide.Shapes.PasteSpecial(DataType:=2, Link:=msoFalse)
myShape.Left = 125
myShape.Top = 350
myShape.ScaleHeight 0.4, msoTrue
Plotsrng.CopyPicture
Set myShape = mySlide.Shapes.PasteSpecial(DataType:=2, Link:=msoFalse)
myShape.Left = 50
myShape.Top = 80
myShape.ScaleHeight 0.38, msoTrue
Next
Application.CutCopyMode = False
Application.Calculation = xlCalculateAutomatic
End Sub
Bookmarks