15 Replies Latest reply: Feb 6, 2012 7:08 AM by rsp-port RSS

    VB Makro Script PPT and Listbox

      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.

        • VB Makro Script PPT and Listbox
          Fernando Suzuki

          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

            • VB Makro Script PPT and Listbox

              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

                • VB Makro Script PPT and Listbox
                  Fernando Suzuki

                  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.

                    • VB Makro Script PPT and Listbox

                      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

                        • VB Makro Script PPT and Listbox
                          m w

                          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

                            • VB Makro Script PPT and Listbox

                              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

                                • VB Makro Script PPT and Listbox
                                  m w

                                  From API guide:

                                  ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard

                                    • VB Makro Script PPT and Listbox

                                      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

                                        • VB Makro Script PPT and Listbox
                                          m w

                                          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.

                                            • VB Makro Script PPT and Listbox

                                              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

                                                • VB Makro Script PPT and Listbox
                                                  m w

                                                  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)

                                                    • VB Makro Script PPT and Listbox
                                                      Vladimir Kostochka

                                                      Hi guys,

                                                       

                                                       

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

                                                       

                                                      Thanks so much,

                                                      • VB Makro Script PPT and Listbox

                                                        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?

                                                          • VB Makro Script PPT and Listbox
                                                            m w

                                                            I overlooked that i starts at 0.

                                                            Try:

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

                                                             

                                                            If that fails, you might attach your qvw.

                                                              • VB Makro Script PPT and Listbox

                                                                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