So, the title is a tad misleading.... It does copy a few of the right charts into power point without duplicating... Then it will randomly get to a certain chart and copy that chart 2 or 3 times into slides I don't designate. There is no reason for this within the code below (at least not with my level of knowledge) and I've looked a lot over the web for this problem/solution to no avail..... Here is a copy of the code:
I've added in wait times thinking that the program speeds were hindering performance. Didn't make a difference.
I've added in "Application.CutCopyMode = False" within the code to clear the clipboard cache. Didn't make a difference.
Anyone else run into this problem or see something in my code that is screwing things up?
Thanks a bunch. - Steve -
Code:
Sub SCOM_Charts()
ActiveSheet.Shapes.Range(Array("Object 4")).Select
Selection.Verb Verb:=3
If Not Application.CalculationState = xlDone Then
DoEvents
End If
Application.CalculateUntilAsyncQueriesDone
Application.Wait (Now + TimeValue("00:00:03"))
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyChartArray As Variant
Dim X As Long
Dim MySlideArray2 As Variant
Dim MyChartArray2 As Variant
Dim X2 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, action aborted."
Exit Sub
End If
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, action aborted."
Exit Sub
End If
On Error GoTo 0
PowerPointApp.ActiveWindow.Panes(2).Activate
Set myPresentation = PowerPointApp.ActivePresentation
MySlideArray = Array(2, 3, 4, 5, 6, 7, 8)
MyChartArray = Array(Sheet2.ChartObjects("A-01"), Sheet2.ChartObjects("A-02"), Sheet2.ChartObjects("A-04"), Sheet2.ChartObjects("A-07"), Sheet2.ChartObjects("A-08"), Sheet1.ChartObjects("V-02"), Sheet1.ChartObjects("V-01"))
For X = LBound(MySlideArray) To UBound(MySlideArray)
MyChartArray(X).Copy
On Error Resume Next
Set shp = myPresentation.Slides(MySlideArray(X)).Shapes.Paste 'Excel 2007-2010
Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
On Error GoTo 0
With myPresentation.PageSetup
On Error Resume Next
shp.LinkFormat.BreakLink
End With
Application.CutCopyMode = False
Application.Wait (Now + TimeValue("00:00:01"))
Next X
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.CutCopyMode = False
ThisWorkbook.Activate
MsgBox "Export to PowerPoint complete. Note: **All slides will be lost when this workbook is closed.**"
End Sub
I've added in wait times thinking that the program speeds were hindering performance. Didn't make a difference.
I've added in "Application.CutCopyMode = False" within the code to clear the clipboard cache. Didn't make a difference.
Anyone else run into this problem or see something in my code that is screwing things up?
Thanks a bunch. - Steve -