Re: How to export a graph into PowerPoint from VB application

[User (Legacy)]

Johannes,

Set a reference to PowerPoint in your project.  Here's some code from the automation help file.

Auto2000.exe is available from the Ms Support/ Download section.  Following this is 

some code I wrote to assemble and print 4 pictures per page/slide for my kid's school.

It loads an array with all the names of the jpgs in a directory then puts (and sizes) 4 slides per page and prints.

Use what's usefull to you.

Steve

Sub CreateGraphicOnSlide()

   Dim ppApp As PowerPoint.Application

   Dim ppPres As PowerPoint.Presentation

   Dim ppShape As PowerPoint.Shape

   Dim ppCurrentSlide As PowerPoint.Slide

   Set ppApp = CreateObject("PowerPoint.Application")

   ppApp.Visible = True

   Set ppPres = ppApp.Presentations.Add(msoTrue)

   Set ppCurrentSlide = ppPres.Slides.Add(Index:=1, Layout:=ppLayoutText)

   With ppCurrentSlide

      'Add the ChartFX graphic

       Set ppShape = .Shapes.AddPicture("c:\My Documents\Test.jpg", _

         msoFalse, msoCTrue, 300, 300, 100, 100)

      'Send the graphic to back so we can see any

      'text frames that may be behind

      ppShape.ZOrder msoSendToBack

      'Why not add a couple of text frames?

      'Set the text of the text frames on the slide

      .Shapes(1).TextFrame.TextRange.Text = "PowerPoint Programmability"

      .Shapes(2).TextFrame.TextRange.Text = "Sixteen Point Star"

      'Bring the text frames to the front, so the

      'graphic doesn't hide them

      .Shapes(1).ZOrder msoBringToFront

      .Shapes(2).ZOrder msoBringToFront

      'Add the 16 point star graphic shape

       Set ppShape = .Shapes.AddShape( _

          Type:=msoShape16pointStar, _

          left:=300, _

          top:=300, _

          Width:=100, _

          Height:=100)

      ppShape.Fill.PresetTextured msoTextureWovenMat

      'Send the graphic to back so we can see the

      'text frames

      ppShape.ZOrder msoSendToBack

   End With

   'Save the presentation and exit Microsoft PowerPoint

   ppPres.SaveAs "c:\My Documents\pptExample2", ppSaveAsPresentation

   ppApp.Quit

   Set ppApp = Nothing

End Sub

Sub cmdAssemble_Click()

    'to print 4 slides per page

    'set some variables

    On Error GoTo err_Sub

    Dim Ppt As PowerPoint.Application

    Dim Pres As PowerPoint.Presentation

    Dim oPicture As PowerPoint.Shape

    Dim oSlide As PowerPoint.Slide

    Dim dblVar As Double

    Dim i As Long

    Dim s As Long

    Dim sf As Single

    Dim sglWidth As Single

    Dim sglHeight As Single

    Dim strInbox As String

    Dim strOutbox As String

    Dim strSlideShow As String

    Dim strCurrentFile As String

    Dim FileArray(1 To 4) As Variant

    Dim intPrint As Integer

    'path statements

    strInbox = "c:\Inbox\"

    strOutbox = "c:\Completed\"

    strSlideShow = "c:\Slideshow\"

    'load filearray

    strCurrentFile = Dir(strInbox & "*.jp*")

    i = 1

    If strCurrentFile <> "" Then

        FileArray(i) = strCurrentFile

    Else

        MsgBox "No Images to process in the directory: " & strInbox, vbCritical, "Nothing to Do!"

        GoTo exit_Oops  'bomb out

    End If

    Do

        'MsgBox FileArray(i)

        strCurrentFile = Dir

        If strCurrentFile <> "" Then

            i = i + 1

            If i > 4 Then

                Exit Do 'only 4 slides per page

            End If

            FileArray(i) = strCurrentFile

        Else

            Exit Do

        End If

    Loop

    'check to see if we have 4 slides

    If i < 4 Then

        intPrint = MsgBox("There are only " & i & " slides ready to go." & vbCrLf & vbCrLf & "Do you want to print now?", vbQuestion + vbOKCancel + vbDefaultButton2, "Print?")

        If intPrint = 2 Then

            MsgBox "Print cancelled", vbInformation, "Cancelled"

            GoTo exit_Oops

        End If

    End If

    On Error Resume Next

    ' Attempt to reference PowerPoint which might be running.

    Set Ppt = GetObject(, "PowerPoint.Application")

    'If Ppt is Nothing, PowerPoint is not running.

    If Ppt Is Nothing Then

        'Create a new instance of the PowerPoint application.

        Set Ppt = CreateObject("PowerPoint.Application")

        'If true, MS PowerPoint is not installed.

        If Ppt Is Nothing Then

            MsgBox "MS PowerPoint is not installed on your computer"

        End If

    End If

    'erase this line later

    Ppt.Visible = msoTrue

    Ppt.WindowState = ppWindowMaximized

    'reset error handler

    On Error GoTo err_Sub

    'check to see if there is an open presentation

    If Ppt.Presentations.Count <> 0 Then

        Ppt.Presentations(1).Close

    End If

    'open a presentation

    Set Pres = Ppt.Presentations.Add

    With Pres.PageSetup

        .SlideSize = ppSlideSizeCustom

        .SlideWidth = 756

        .SlideHeight = 576

        .FirstSlideNumber = 1

        .SlideOrientation = msoOrientationHorizontal

    End With

    s = 1   'variable for picture counter start at 1

    'Add Slide

    Set oSlide = Pres.Slides.Add(s, ppLayoutBlank)

    Do

        '4 slides per page

        If s > 4 Then

            Exit Do

        End If

        'check for valid filename in array

        If FileArray(s) = "" Then

            Exit Do

        End If

        'Adding pictures

            Select Case s

                Case 1

                    'Add Picture

                    oSlide.Shapes.AddPicture strInbox & FileArray(s), _

                        msoTrue, msoFalse, 31, 5, 346, 264

                Case 2

                    'Add Picture

                    oSlide.Shapes.AddPicture strInbox & FileArray(s), _

                        msoTrue, msoFalse, 410, 5, 346, 264

                Case 3

                    'Add Picture

                    oSlide.Shapes.AddPicture strInbox & FileArray(s), _

                        msoTrue, msoFalse, 31, 310, 346, 264

                Case 4

                    'Add Picture

                    oSlide.Shapes.AddPicture strInbox & FileArray(s), _

                        msoTrue, msoFalse, 410, 310, 346, 264

            End Select

        'increment picture counter and do it again

        s = s + 1

    Loop

exit_Point: 'regular exit point with some printing and cleanup

    'print the slide when done

    Pres.PrintOut

    DoEvents

    'Windows 9x specific

    'wait until the presentation starts to print

    Do While Dir("C:\WINDOWS\SPOOL\PRINTERS\*.spl") = ""

        DoEvents

    Loop

    'now loop until spool file is off the local disk

    Do While Dir("C:\WINDOWS\SPOOL\PRINTERS\*.spl") <> ""

        DoEvents

    Loop

    'close presentation

    Pres.Close

    'close powerpoint

    Ppt.Quit

    'move files to y:\slideshow and z:\completed

    For i = 1 To 4

        If FileArray(i) = "" Then

            Exit For

        End If

        'copy file to "completed"

        FileCopy strInbox & FileArray(i), strOutbox & FileArray(i)

        'copy file to "slideshow"

        FileCopy strInbox & FileArray(i), strSlideShow & FileArray(i)

        'KILL inbox copy

        Kill strInbox & FileArray(i)

    Next

    'show we're done

    MsgBox "We're done!", vbInformation, "Next!"

exit_Oops:  'exit here if we didn't want to print

    'release variables

    Set oPicture = Nothing

    Set oSlide = Nothing

    Set Pres = Nothing

    Set Ppt = Nothing

    'adios

    Exit Sub

err_Sub:

    Select Case Err.Number

        Case Else

            MsgBox "Unanticipated error: " & Err.Number & " " & Err.Description

            Stop

            Resume

    End Select

End Sub

Johannes Appelo <jappelo@intekom.co.za> wrote in message news:tiW8SP0$AHA.952@sfxserver.softwarefx.com...

> Hi,

> 

> I am trying to export a ChartFX chart generated via a VB application into a

> PowerPoint presentation. I do not have any ideas where to start, can anybody

> point me into the right direction or refer me to reading material?

> 

> Thanks - Hans Appelo

> 

>