Need Help on Macro to Copy Shape and Paste into PowerPoint

[Mysore]

Hello Folks

I have got a macro that copies Excel Sheets and pastes onto Powerpoint which works fine, however I have specific sheets which
holds Grouped Shapes (Basically Excel Chart with some Text Boxes) in which case the macro fails.
I have reasonably searched various articles and forums but was not able to resolve.

Appreciate if someone can tweak my code.


Sub ExporttoPPT()

'variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim Xchart As Excel.ChartObject
Dim xlShape As Object
Dim SlideCount As Long
Dim row As Long

'pp variable = Create a new powerpoint presentation
Set pp = CreateObject("PowerPoint.Application")

'Powerpoint presentation = add the object (the finished product) to the poewrpoint presentation
Set PPPres = pp.Presentations.Add

'powerpoint is now visible
pp.Visible = True

'Hide specific Sheets to generate the Pack

For Each wsname In Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet41.Name)
Worksheets(wsname).Visible = False
Next


'range you pick for selection
MyRange = ActiveSheet.PageSetup.PrintArea

'For each worksheet in the active workbook select all the worksheets and wait however many seconds
For Each xlwksht In ActiveWorkbook.Worksheets
If xlwksht.Visible = True Then
xlwksht.Select
Application.Wait (Now + TimeValue("0:00:1"))

'copy the picture from the range you selected

' Check if there is a shape in the activesheet
If ActiveSheet.Shapes.Count > 0 Then

ActiveSheet.Shapes("Group1").Select

'Appearance:=xlScreen, Format:=xlPicture

Else


MyRange = ActiveSheet.PageSetup.PrintArea

xlwksht.Range(MyRange).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

End If

'Slide count
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select

'paste the shapes
PPSlide.Shapes.Paste
pp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = True
pp.ActiveWindow.Selection.ShapeRange.Top = 20
pp.ActiveWindow.Selection.ShapeRange.Left = 20
pp.ActiveWindow.Selection.ShapeRange.Width = 700
pp.ActiveWindow.Selection.ShapeRange.Height = 350



End If
Next xlwksht

pp.Activate


'Cleans it up
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing


Sheet1.Visible = True
End Sub

[macropod]

Cross-posted at: https://www.excelforum.com/excel-programming-vba-macros/1303909-need-help-on-macro-to-copy-shape-and-paste-into-powerpoint.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[Aussiebear]

I have reasonably searched various articles and forums but was not able to resolve.

Given your level of experience in forums..... I am left wondering why you would cross post without informing those members of your having done so?