Macro Help

[NavinReddy]

Hi Community,

could some one help me get out this query

i need your help

Copy and Paste Dashboard contents into Powerpoint (2^nd Slide) when a button is clicked (using a Macro OR even otherwise)

Thanks in Advance

Niru

[NavinReddy]

any idea guys

[rustyfishbones · Accepted solution]

yes you can try below, it will export all charts to powerpoint.

It's set to save in this location C:\temp\MyPresentationPPT.ppt, but you can change that to suit you and it wil close the powerpoint once exported

Dont forget to allow system access, BTW, this is not my code I found it a while ago! but it does work!

SUB ppt1

Set PPApp = CreateObject("Powerpoint.Application")

MsgBox("Hello You are sending Charts to Powerpoint")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

'''''''''' For All Sheets '''''''''

for j = 0 to ActiveDocument.NoOfSheets - 1

  ActiveDocument.Sheets(j).Activate

  set ss= ActiveDocument.GetSheet(j)

    shID =ucase(mid(ss.GetProperties.SheetID,10))

  shName=ss.GetProperties.Name

  ActiveDocument.GetApplication.WaitForIdle

  'ActiveDocument.GetApplication.Sleep 5000

  'msgbox shName & "--" & shID

''''''''''''''''''''''''''''''''''''''''''

  ActiveDocument.Sheets(shName).Activate

  ActiveDocument.Sheets(j).Activate

  set s=ActiveDocument.ActiveSheet

  charts=s.GetSheetObjects

  for i=lbound(charts) to ubound(charts)

  if(UCASE(mid(charts(i).getobjectid,10,2)))="CH" then

  Set PPSlide = PPPres.Slides.Add(1, 1)

  PPSlide.Shapes(1).Delete ' removes the title

  PPSlide.Shapes(1).Delete ' removes the text box

  ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard

  PPSlide.Shapes.Paste

  'ActiveDocument.GetApplication.Sleep 1000

  end if

  next

next ''for sheets next move

PPPres.SaveAs "C:\temp\MyPresentationPPT.ppt"

PPPres.Close

PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

END SUB

[NavinReddy]

Hi Alan,

Thanks you so much