VB Makro Script PPT and Listbox

[#1]

Hello at all,

i want to export all of my charts in a PowerPoint File and only the charts that i selected over a Listbox.

The first part, all charts into a PowerPoint File i have realize it over the following VB Script.

sub ppt_alle
 Set PPApp = CreateObject("Powerpoint.Application")
 PPApp.Visible = True ' Create a presentation 
 Set PPPres = PPApp.Presentations.Add
 set s=ActiveDocument.Sheets("Frequenzbericht")
 charts=s.GetGraphs
 for i=lbound(charts) to ubound(charts)
  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).maximize
  ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard
  ActiveDocument.GetSheetObject(charts(i).getobjectid).minimize
  with PPSlide.Shapes.Paste
      .Left = 0
      .Top = 30
      .Width=720
  end with
 next
  set s=ActiveDocument.Sheets("Report")
 charts=s.GetGraphs
 for i=lbound(charts) to ubound(charts)
  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).maximize
  ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard
  ActiveDocument.GetSheetObject(charts(i).getobjectid).minimize
  with PPSlide.Shapes.Paste
      .Left = 0
      .Top = 30
      .Width=720
  end with
 next
 PPPres.SaveAs "C:\Alle_Charts.ppt" 
 'PPPres.Close 
'PPApp.Quit 
 Set PPSlide = Nothing 
 Set PPPres = Nothing 
 Set PPApp = Nothing
end sub

Now i want to make a Listbox with the Chart IDs and get the selected value into my VB Script to take only the selected charts to PowerPoint. Therefore my first question is, how i can make a Listbox with the Chart IDs?

And then how i can access to the selected value in my VB Script to export it into the PowerPoint File?

Thank you for helping me.

[#2]

When i make this, i only get the first select and not both.

sub test

Set PPApp = CreateObject("Powerpoint.Application")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

'set s=ActiveDocument.Sheets("Basis")

'charts=s.GetGraphs

set LB = ActiveDocument.GetSheetObject("LB01")

boxvalues=LB.GetPossibleValues

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

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

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

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

   ActiveDocument.GetSheetObject(boxvalues(i)).maximize

   ActiveDocument.GetSheetObject(boxvalues(i)).CopyBitmapToClipboard

   ActiveDocument.GetSheetObject(boxvalues(i)).minimize

   with PPSlide.Shapes.Paste.Select

   PPApp.ActiveWindow.Selection.ShapeRange.Top = 462

  PPApp.ActiveWindow.Selection.ShapeRange.Left = 654

  end with

next

PPPres.SaveAs "C:\Test.ppt"

'PPPres.Close

'PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

[m_woolf]

Are you trying to paste each bitmap on a different slide?

If so, change:

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

to

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

[Anonymous]

Hi guys,

Could you explain where I can take or run "PowerPoint Application"?

Thanks so much,

[#5]

sub Alle_PPT

Set PPApp = CreateObject("Powerpoint.Application")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

set s=ActiveDocument.Sheets("TV")

charts=s.GetGraphs

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

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

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

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

  'ActiveDocument.GetSheetObject(charts(i).getobjectid).maximize

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

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

  with PPSlide.Shapes.Paste.Select

      .Left = 0

      .Top = 30

      .Width=720

end with

next

PPPres.SaveAs "C:\Test_PP.ppt"

'PPPres.Close

'PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

There is no chart on a site when i change the

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

into

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

What´s wrong with it?

[m_woolf]

I overlooked that i starts at 0.

Try:

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

If that fails, you might attach your qvw.

[#7]

Hi at all,

i have a last question. Everything works fine, but i have some charts they are not active before a selection

where made. So i would like to prouve the graph (chart) they are active or not and so export it or not to

Power Point.

I found in the API the following

IF ActiveDocument.GetSheetObject(charts(i).getobjectid).IsActive Then

But it doesn´t work, have i made a mistake in the Position from the IF Statement?

Here is my code:

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

IF ActiveDocument.GetSheetObject(charts(i).getobjectid).IsActive Then

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

  'Set PPSlide = PPPres.Slides.Add(i + 1, 1) Wenn ID größer 0

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

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

  'Wenn das Chart minimiert ist dann muss es maximiert werden um exportiert zu werden

  IF ActiveDocument.GetSheetObject(charts(i).getobjectid).isMinimized Then

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

  END IF

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

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

  with PPSlide.Shapes.Paste

      .Left = 0

      .Top = 30

      .Width=720

end with

END IF

next