Jump to content
Software FX Community

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


User (Legacy)
 Share

Recommended Posts

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

>

>

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...