Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
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.
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.
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
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
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.
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
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
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
From API guide:
ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard
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
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.