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.

[fosuzuki]

Hi,

you can add in the load script the load of your document's charts:

SheetObject:

LOAD ObjectId,

    Caption,

    Type

FROM C:\Sample.qvw (XmlSimple, Table is [DocumentSummary/SheetObject]);

Hope this points you in the right direction.

Regards,

Fernando

[#3]

Hi Fernando,

do you mean that i have to reopen my qvw file to get the Sheet Objects?

When i do this i get an error message that the file can not found.

Regards

[fosuzuki]

1. add the script section I posted (obviously u need to fix the file path and file name)

2. Reload the app

3. create a listbox using the Caption field

4. in your export macro, loop the selected values in this field to check which ones the user selected

Btw, which QV version are u using? I'n on QV10SR2.

[#5]

Hello,

i use the QV Version 11.

Now i have the following Chart ID in my Listbox (CH31,CH32,CH33).The Name of the Listbox "LB224".

Now i want to loop the selectedValues of the Listbox.And then add these charts into ppt.

sub test

Set PPApp = CreateObject("Powerpoint.Application")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

//Here are the problem

//How can i loop the selectedValues and then loop through an array???

set s=ActiveDocument.Sheets() //How can i loop all Sheets????

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

PPPres.SaveAs "C:\Test.ppt" 'Angabe Pfad PPT

PPPres.Close

'PPApp.Quit  Läßt das PowerPoint Dokument offen

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

[m_woolf]

From API Guide:

rem ** show each possible value in list box **

set LB = ActiveDocument.GetSheetObject("LB01")

boxvalues=LB.GetPossibleValues

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

    msgbox(boxvalues(i))

next

[#7]

Hello mwoolf,

thx, i tried it and i get my selection. All right, that is great, but how i can combine it with my ppt script? I tried this:

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

   charts.boxvalues(i).maximize

   charts.boxvalues(i).CopyBitmapToClipboard

   charts.boxvalues(i).minimize

  with PPSlide.Shapes.Paste

  end with

next

PPPres.SaveAs "C:\Test.ppt"

'PPPres.Close

'PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

But the PPT File is empty.

What do i wrong? Here is the script which get all charts.

sub Alle_PPT

Set PPApp = CreateObject("Powerpoint.Application")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

set s=ActiveDocument.Sheets("Basis")

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

  end with

next

PPPres.SaveAs "C:\Alle_Charts.ppt"

'PPPres.Close

'PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

Thx for help

[m_woolf]

From API guide:

ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard

[#9]

THX, i solve it.

Here the code:

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

  end with

next

PPPres.SaveAs "C:\Test.ppt"

'PPPres.Close

'PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

A last question, the two charts are not in the middle of one sheet in the ppt. How i can place them right?

THX

[m_woolf · Accepted solution]

Change you line that pastes the bitmap to:

PPSlide.Shapes.Paste.Select

Then you can fiddle with the Top and Left values:

PPApp.ActiveWindow.Selection.ShapeRange.Top = 462
PPApp.ActiveWindow.Selection.ShapeRange.Left = 654

The ShapeRange object also has Width and Height properties, if you want to calculate Top and Left to center the object on the slide.