How to insert embed Visio OLE Object into Power Point?

[Gary]

The access new group suggested for me to post here on the Visio group.
I have an embed Visio drawings in an OLE Object field of a Access Table.
This allows me to move the drawings around with its data. I need a program
of taking the embed Visio data and inserting it into power point.

I have a first cut of this, but the program run slow because it first
activate the embed Visio OLE Object and and I save it to a temp file and use
an AddOLEObject to add it into power point.

I have a form which is associated with the table that has the Visio
OLEObject. It create a bound object and set the verb = -2 which opens up the
Visio separately when I activate the OLEObject. I then saveas the activated
Visio to the temp file. I noticed that AddOLEObject take a file and inserts
it.

Here is my code:

Private Sub Command19_Click()
Dim oPPT As PowerPoint.Application
Dim oPres As Presentation
Dim xWidth As Integer, yHeight As Integer

Dim AppVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim db As Database
Dim T As DAO.Recordset

Set db = DBEngine.Workspaces(0).Databases(0)
Set T = db.OpenRecordset("tblLoadOLE")

T.MoveFirst

Set oPPT = New PowerPoint.Application
Set oPres = oPPT.Presentations.Add(True)

Const ppLayoutBlank = 12
Const ppSaveAsPresentation = 1

xWidth = (11 * 1440) / 20
yHeight = (8.5 * 1440) / 20
' yHeight = (6.8 * 1440) / 20

oPres.PageSetup.SlideWidth = xWidth
oPres.PageSetup.SlideHeight = yHeight

Do Until T.EOF
'For i = 1 To 2

Me![OLEFile].Action = acOLEActivate

Set AppVisio = GetObject(, "visio.application")
Set DocObj = AppVisio.ActiveDocument
DocObj.SaveAs "c:\access 2006\MyDrawing.vsd"

AppVisio.Quit
Set AppVisio = Nothing

oPres.Slides.Add(oPres.Slides.Count + 1,
ppLayoutBlank).Shapes.AddOLEObject Left:=0, Top:=0, Width:=xWidth,
Height:=yHeight, FileName:="c:\access 2006\MyDrawing.vsd", Link:=msoFalse
DoCmd.RunCommand acCmdRecordsGoToNext
T.MoveNext
Loop
'Next i

oPres.SaveAs "c:\access 2006\MyDrawing.ppt", ppSaveAsPresentation, True

oPres.Close
Set oPres = Nothing
oPPT.Quit
Set oPPT = Nothing

End Sub

Can some one help me to make this run faster?

My technique is openning all these windows and closing them and its takes
about 3-4 second per slides. If someone can show me what to do where these
windows are not open, it should be faster, or a better solution would be
great!


In the AddOLEObject, it seems to be a one to one scalling between the Visio
to the power point. Can some one also show me how to have the ability to
scale the Visio to fit full size on the power point?


I need all the help I can get. Thank You,

G

 

[Al Edlund]

I use this to copy visio charts to powerpoint. As you observed moving to and
from files can add time. If I were going to use this I would probably query
the data to find out how many records/sheets I needed first, open an
instance of visio (like you have), copy the images to the visio sheet by
first grouping them, and then use the clipboard path rather than a file
path. Rather than ungrouping at the end of the page copy I would delete the
group so that I had a clean sheet to copy the next image from.
hope it helps,
al

'*********************************************************************

'*********************************************************************

'

' these are the powerpoint functions

' This is setup to copy the components from foreground pages

'

'*********************************************************************

'*********************************************************************



Public Sub subGeneratePowerPoint()

Dim visApp As Visio.Application

Dim visDocument As Visio.Document

Dim visPage As Visio.Page

Dim iObjCtr As Integer

Dim iConCtr As Integer

Dim iPagCtr As Integer

Dim strForeground As String

Dim strBackground As String

Dim shpGroup As Microsoft.Office.Interop.Visio.Shape

Const MAX_SLIDES As Long = 250

Dim lLastSlide As Long

Dim lToCreate As Long = 10

Dim lResult As Long

Dim Continue As Boolean

Dim strResult As String

Try

visDocument = visApp.ActiveDocument

Dim ppApp As PowerPoint.Application

Dim ppPres As PowerPoint.Presentation

Dim ppSlide As PowerPoint.Slide

Dim bAssistantOn As Boolean

'Start Powerpoint and make its window visible but minimized.

ppApp = New PowerPoint.Application

'oApp.Visible = cOffice.msoTrue

ppPres = ppApp.Presentations.Add(cOffice.MsoTriState.msoTrue)

lLastSlide = ppPres.Slides.Count

'first we create the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' we dont want to include the background slides

If visDocument.Pages(iPagCtr).Background = 0 Then

lLastSlide = lLastSlide + CLng(1)

ppPres.Slides.Add(lLastSlide, ppLayoutBlank)

If err.Number <> 0 Then

strResult = "Unable to add new slides " & err.Description

MsgBox(strResult, vbCritical, "Error Adding Slides")

End If ' test for slide being created

End If ' test for background

Next iPagCtr

' now we populate the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' Debug.Print "powerpoint page " & iPagCtr

strForeground = ""

strBackground = ""

If visDocument.Pages(iPagCtr).Background = False Then

' move page to active window

strForeground = visDocument.Pages(iPagCtr).Name

'If Not (visDocument.Pages(iPagCtr).BackPage Is Nothing) Then

' strBackground = visDocument.Pages(iPagCtr).BackPage

' we can add code here to add background to the slide

' ActiveWindow.Page = strBackground

' but not today

'Else

' strBackground = "NoBackground"

'End If

visApp.ActiveWindow.Page = strForeground

visApp.ActiveWindow.SelectAll()

visApp.ActiveWindow.Group()

shpGroup = visApp.ActivePage.Shapes.Item(visApp.ActivePage.Shapes.Count)

' Debug.Print "powerpoint objects " & ActivePage.Shapes.Count

' copy selected items to clipboard

visApp.ActiveWindow.Copy()

' Debug.Print "copied"

' Paste Visio drawing from the clipboard to Powerpoint correct slide

ppPres.Slides.Item(iPagCtr).Shapes.Paste()

' now paste the page name into the slides footer as a label

ppPres.Slides.Item(iPagCtr).HeadersFooters.Footer.Text = strForeground

System.Windows.Forms.Application.DoEvents()

' Debug.Print "pasted"

' now let's ungroup them

shpGroup.Ungroup()

' Debug.Print "ungrouped"

' deselect the objects so we dont get confused

visApp.ActiveWindow.DeselectAll()

' give the system back some time to get things done

End If

System.Windows.Forms.Application.DoEvents()

Next iPagCtr

Catch err As Exception

subLogException(err)

subDisplayException(Nothing, err)

End Try

End Sub

The access new group suggested for me to post here on the Visio group.
I have an embed Visio drawings in an OLE Object field of a Access Table.
This allows me to move the drawings around with its data. I need a
program
of taking the embed Visio data and inserting it into power point.

I have a first cut of this, but the program run slow because it first
activate the embed Visio OLE Object and and I save it to a temp file and
use
an AddOLEObject to add it into power point.

I have a form which is associated with the table that has the Visio
OLEObject. It create a bound object and set the verb = -2 which opens up
the
Visio separately when I activate the OLEObject. I then saveas the
activated
Visio to the temp file. I noticed that AddOLEObject take a file and
inserts
it.

Here is my code:

Private Sub Command19_Click()
Dim oPPT As PowerPoint.Application
Dim oPres As Presentation
Dim xWidth As Integer, yHeight As Integer

Dim AppVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim db As Database
Dim T As DAO.Recordset

Set db = DBEngine.Workspaces(0).Databases(0)
Set T = db.OpenRecordset("tblLoadOLE")

T.MoveFirst

Set oPPT = New PowerPoint.Application
Set oPres = oPPT.Presentations.Add(True)

Const ppLayoutBlank = 12
Const ppSaveAsPresentation = 1

xWidth = (11 * 1440) / 20
yHeight = (8.5 * 1440) / 20
' yHeight = (6.8 * 1440) / 20

oPres.PageSetup.SlideWidth = xWidth
oPres.PageSetup.SlideHeight = yHeight

Do Until T.EOF
'For i = 1 To 2

Me![OLEFile].Action = acOLEActivate

Set AppVisio = GetObject(, "visio.application")
Set DocObj = AppVisio.ActiveDocument
DocObj.SaveAs "c:\access 2006\MyDrawing.vsd"

AppVisio.Quit
Set AppVisio = Nothing

oPres.Slides.Add(oPres.Slides.Count + 1,
ppLayoutBlank).Shapes.AddOLEObject Left:=0, Top:=0, Width:=xWidth,
Height:=yHeight, FileName:="c:\access 2006\MyDrawing.vsd", Link:=msoFalse
DoCmd.RunCommand acCmdRecordsGoToNext
T.MoveNext
Loop
'Next i

oPres.SaveAs "c:\access 2006\MyDrawing.ppt", ppSaveAsPresentation, True

oPres.Close
Set oPres = Nothing
oPPT.Quit
Set oPPT = Nothing

End Sub

Can some one help me to make this run faster?

My technique is openning all these windows and closing them and its takes
about 3-4 second per slides. If someone can show me what to do where
these
windows are not open, it should be faster, or a better solution would be
great!


In the AddOLEObject, it seems to be a one to one scalling between the
Visio
to the power point. Can some one also show me how to have the ability to
scale the Visio to fit full size on the power point?


I need all the help I can get. Thank You,

G

 

[Gary]

Thank You!

I have a question of the Paste.

I assume it keeps the OLE Object such that I can still open up Visio in
Power Point??? I am at work and can't try it until tonight.

Gary

I use this to copy visio charts to powerpoint. As you observed moving to and
from files can add time. If I were going to use this I would probably query
the data to find out how many records/sheets I needed first, open an
instance of visio (like you have), copy the images to the visio sheet by
first grouping them, and then use the clipboard path rather than a file
path. Rather than ungrouping at the end of the page copy I would delete the
group so that I had a clean sheet to copy the next image from.
hope it helps,
al

'*********************************************************************

'*********************************************************************

'

' these are the powerpoint functions

' This is setup to copy the components from foreground pages

'

'*********************************************************************

'*********************************************************************



Public Sub subGeneratePowerPoint()

Dim visApp As Visio.Application

Dim visDocument As Visio.Document

Dim visPage As Visio.Page

Dim iObjCtr As Integer

Dim iConCtr As Integer

Dim iPagCtr As Integer

Dim strForeground As String

Dim strBackground As String

Dim shpGroup As Microsoft.Office.Interop.Visio.Shape

Const MAX_SLIDES As Long = 250

Dim lLastSlide As Long

Dim lToCreate As Long = 10

Dim lResult As Long

Dim Continue As Boolean

Dim strResult As String

Try

visDocument = visApp.ActiveDocument

Dim ppApp As PowerPoint.Application

Dim ppPres As PowerPoint.Presentation

Dim ppSlide As PowerPoint.Slide

Dim bAssistantOn As Boolean

'Start Powerpoint and make its window visible but minimized.

ppApp = New PowerPoint.Application

'oApp.Visible = cOffice.msoTrue

ppPres = ppApp.Presentations.Add(cOffice.MsoTriState.msoTrue)

lLastSlide = ppPres.Slides.Count

'first we create the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' we dont want to include the background slides

If visDocument.Pages(iPagCtr).Background = 0 Then

lLastSlide = lLastSlide + CLng(1)

ppPres.Slides.Add(lLastSlide, ppLayoutBlank)

If err.Number <> 0 Then

strResult = "Unable to add new slides " & err.Description

MsgBox(strResult, vbCritical, "Error Adding Slides")

End If ' test for slide being created

End If ' test for background

Next iPagCtr

' now we populate the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' Debug.Print "powerpoint page " & iPagCtr

strForeground = ""

strBackground = ""

If visDocument.Pages(iPagCtr).Background = False Then

' move page to active window

strForeground = visDocument.Pages(iPagCtr).Name

'If Not (visDocument.Pages(iPagCtr).BackPage Is Nothing) Then

' strBackground = visDocument.Pages(iPagCtr).BackPage

' we can add code here to add background to the slide

' ActiveWindow.Page = strBackground

' but not today

'Else

' strBackground = "NoBackground"

'End If

visApp.ActiveWindow.Page = strForeground

visApp.ActiveWindow.SelectAll()

visApp.ActiveWindow.Group()

shpGroup = visApp.ActivePage.Shapes.Item(visApp.ActivePage.Shapes.Count)

' Debug.Print "powerpoint objects " & ActivePage.Shapes.Count

' copy selected items to clipboard

visApp.ActiveWindow.Copy()

' Debug.Print "copied"

' Paste Visio drawing from the clipboard to Powerpoint correct slide

ppPres.Slides.Item(iPagCtr).Shapes.Paste()

' now paste the page name into the slides footer as a label

ppPres.Slides.Item(iPagCtr).HeadersFooters.Footer.Text = strForeground

System.Windows.Forms.Application.DoEvents()

' Debug.Print "pasted"

' now let's ungroup them

shpGroup.Ungroup()

' Debug.Print "ungrouped"

' deselect the objects so we dont get confused

visApp.ActiveWindow.DeselectAll()

' give the system back some time to get things done

End If

System.Windows.Forms.Application.DoEvents()

Next iPagCtr

Catch err As Exception

subLogException(err)

subDisplayException(Nothing, err)

End Try

End Sub

The access new group suggested for me to post here on the Visio group.
I have an embed Visio drawings in an OLE Object field of a Access Table.
This allows me to move the drawings around with its data. I need a
program
of taking the embed Visio data and inserting it into power point.

I have a first cut of this, but the program run slow because it first
activate the embed Visio OLE Object and and I save it to a temp file and
use
an AddOLEObject to add it into power point.

I have a form which is associated with the table that has the Visio
OLEObject. It create a bound object and set the verb = -2 which opens up
the
Visio separately when I activate the OLEObject. I then saveas the
activated
Visio to the temp file. I noticed that AddOLEObject take a file and
inserts
it.

Here is my code:

Private Sub Command19_Click()
Dim oPPT As PowerPoint.Application
Dim oPres As Presentation
Dim xWidth As Integer, yHeight As Integer

Dim AppVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim db As Database
Dim T As DAO.Recordset

Set db = DBEngine.Workspaces(0).Databases(0)
Set T = db.OpenRecordset("tblLoadOLE")

T.MoveFirst

Set oPPT = New PowerPoint.Application
Set oPres = oPPT.Presentations.Add(True)

Const ppLayoutBlank = 12
Const ppSaveAsPresentation = 1

xWidth = (11 * 1440) / 20
yHeight = (8.5 * 1440) / 20
' yHeight = (6.8 * 1440) / 20

oPres.PageSetup.SlideWidth = xWidth
oPres.PageSetup.SlideHeight = yHeight

Do Until T.EOF
'For i = 1 To 2

Me![OLEFile].Action = acOLEActivate

Set AppVisio = GetObject(, "visio.application")
Set DocObj = AppVisio.ActiveDocument
DocObj.SaveAs "c:\access 2006\MyDrawing.vsd"

AppVisio.Quit
Set AppVisio = Nothing

oPres.Slides.Add(oPres.Slides.Count + 1,
ppLayoutBlank).Shapes.AddOLEObject Left:=0, Top:=0, Width:=xWidth,
Height:=yHeight, FileName:="c:\access 2006\MyDrawing.vsd", Link:=msoFalse
DoCmd.RunCommand acCmdRecordsGoToNext
T.MoveNext
Loop
'Next i

oPres.SaveAs "c:\access 2006\MyDrawing.ppt", ppSaveAsPresentation, True

oPres.Close
Set oPres = Nothing
oPPT.Quit
Set oPPT = Nothing

End Sub

Can some one help me to make this run faster?

My technique is openning all these windows and closing them and its takes
about 3-4 second per slides. If someone can show me what to do where
these
windows are not open, it should be faster, or a better solution would be
great!


In the AddOLEObject, it seems to be a one to one scalling between the
Visio
to the power point. Can some one also show me how to have the ability to
scale the Visio to fit full size on the power point?


I need all the help I can get. Thank You,

G

 

[Al Edlund]

The default for paste is (as I remember) a bmp image. You might take a look
at the eqivalent powerpoint command to see if you can do a paste special
inside the program and select the format.
al

Thank You!

I have a question of the Paste.

I assume it keeps the OLE Object such that I can still open up Visio in
Power Point??? I am at work and can't try it until tonight.

Gary

I use this to copy visio charts to powerpoint. As you observed moving to
and
from files can add time. If I were going to use this I would probably
query
the data to find out how many records/sheets I needed first, open an
instance of visio (like you have), copy the images to the visio sheet by
first grouping them, and then use the clipboard path rather than a file
path. Rather than ungrouping at the end of the page copy I would delete
the
group so that I had a clean sheet to copy the next image from.
hope it helps,
al

'*********************************************************************

'*********************************************************************

'

' these are the powerpoint functions

' This is setup to copy the components from foreground pages

'

'*********************************************************************

'*********************************************************************



Public Sub subGeneratePowerPoint()

Dim visApp As Visio.Application

Dim visDocument As Visio.Document

Dim visPage As Visio.Page

Dim iObjCtr As Integer

Dim iConCtr As Integer

Dim iPagCtr As Integer

Dim strForeground As String

Dim strBackground As String

Dim shpGroup As Microsoft.Office.Interop.Visio.Shape

Const MAX_SLIDES As Long = 250

Dim lLastSlide As Long

Dim lToCreate As Long = 10

Dim lResult As Long

Dim Continue As Boolean

Dim strResult As String

Try

visDocument = visApp.ActiveDocument

Dim ppApp As PowerPoint.Application

Dim ppPres As PowerPoint.Presentation

Dim ppSlide As PowerPoint.Slide

Dim bAssistantOn As Boolean

'Start Powerpoint and make its window visible but minimized.

ppApp = New PowerPoint.Application

'oApp.Visible = cOffice.msoTrue

ppPres = ppApp.Presentations.Add(cOffice.MsoTriState.msoTrue)

lLastSlide = ppPres.Slides.Count

'first we create the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' we dont want to include the background slides

If visDocument.Pages(iPagCtr).Background = 0 Then

lLastSlide = lLastSlide + CLng(1)

ppPres.Slides.Add(lLastSlide, ppLayoutBlank)

If err.Number <> 0 Then

strResult = "Unable to add new slides " & err.Description

MsgBox(strResult, vbCritical, "Error Adding Slides")

End If ' test for slide being created

End If ' test for background

Next iPagCtr

' now we populate the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' Debug.Print "powerpoint page " & iPagCtr

strForeground = ""

strBackground = ""

If visDocument.Pages(iPagCtr).Background = False Then

' move page to active window

strForeground = visDocument.Pages(iPagCtr).Name

'If Not (visDocument.Pages(iPagCtr).BackPage Is Nothing) Then

' strBackground = visDocument.Pages(iPagCtr).BackPage

' we can add code here to add background to the slide

' ActiveWindow.Page = strBackground

' but not today

'Else

' strBackground = "NoBackground"

'End If

visApp.ActiveWindow.Page = strForeground

visApp.ActiveWindow.SelectAll()

visApp.ActiveWindow.Group()

shpGroup = visApp.ActivePage.Shapes.Item(visApp.ActivePage.Shapes.Count)

' Debug.Print "powerpoint objects " & ActivePage.Shapes.Count

' copy selected items to clipboard

visApp.ActiveWindow.Copy()

' Debug.Print "copied"

' Paste Visio drawing from the clipboard to Powerpoint correct slide

ppPres.Slides.Item(iPagCtr).Shapes.Paste()

' now paste the page name into the slides footer as a label

ppPres.Slides.Item(iPagCtr).HeadersFooters.Footer.Text = strForeground

System.Windows.Forms.Application.DoEvents()

' Debug.Print "pasted"

' now let's ungroup them

shpGroup.Ungroup()

' Debug.Print "ungrouped"

' deselect the objects so we dont get confused

visApp.ActiveWindow.DeselectAll()

' give the system back some time to get things done

End If

System.Windows.Forms.Application.DoEvents()

Next iPagCtr

Catch err As Exception

subLogException(err)

subDisplayException(Nothing, err)

End Try

End Sub

The access new group suggested for me to post here on the Visio group.
I have an embed Visio drawings in an OLE Object field of a Access
Table.
This allows me to move the drawings around with its data. I need a
program
of taking the embed Visio data and inserting it into power point.

I have a first cut of this, but the program run slow because it first
activate the embed Visio OLE Object and and I save it to a temp file
and
use
an AddOLEObject to add it into power point.

I have a form which is associated with the table that has the Visio
OLEObject. It create a bound object and set the verb = -2 which opens
up
the
Visio separately when I activate the OLEObject. I then saveas the
activated
Visio to the temp file. I noticed that AddOLEObject take a file and
inserts
it.

Here is my code:

Private Sub Command19_Click()
Dim oPPT As PowerPoint.Application
Dim oPres As Presentation
Dim xWidth As Integer, yHeight As Integer

Dim AppVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim db As Database
Dim T As DAO.Recordset

Set db = DBEngine.Workspaces(0).Databases(0)
Set T = db.OpenRecordset("tblLoadOLE")

T.MoveFirst

Set oPPT = New PowerPoint.Application
Set oPres = oPPT.Presentations.Add(True)

Const ppLayoutBlank = 12
Const ppSaveAsPresentation = 1

xWidth = (11 * 1440) / 20
yHeight = (8.5 * 1440) / 20
' yHeight = (6.8 * 1440) / 20

oPres.PageSetup.SlideWidth = xWidth
oPres.PageSetup.SlideHeight = yHeight

Do Until T.EOF
'For i = 1 To 2

Me![OLEFile].Action = acOLEActivate

Set AppVisio = GetObject(, "visio.application")
Set DocObj = AppVisio.ActiveDocument
DocObj.SaveAs "c:\access 2006\MyDrawing.vsd"

AppVisio.Quit
Set AppVisio = Nothing

oPres.Slides.Add(oPres.Slides.Count + 1,
ppLayoutBlank).Shapes.AddOLEObject Left:=0, Top:=0, Width:=xWidth,
Height:=yHeight, FileName:="c:\access 2006\MyDrawing.vsd",
Link:=msoFalse
DoCmd.RunCommand acCmdRecordsGoToNext
T.MoveNext
Loop
'Next i

oPres.SaveAs "c:\access 2006\MyDrawing.ppt", ppSaveAsPresentation,
True

oPres.Close
Set oPres = Nothing
oPPT.Quit
Set oPPT = Nothing

End Sub

Can some one help me to make this run faster?

My technique is openning all these windows and closing them and its
takes
about 3-4 second per slides. If someone can show me what to do where
these
windows are not open, it should be faster, or a better solution would
be
great!


In the AddOLEObject, it seems to be a one to one scalling between the
Visio
to the power point. Can some one also show me how to have the ability
to
scale the Visio to fit full size on the power point?


I need all the help I can get. Thank You,

G

 

[Gary]

Al:

The program works great!! I have one problem.

Sometimes the Visio program prompts me "If I wish to save large amount of
data to my clipboard". I have to select the key manually and say yes. It
then continues working.


I read that I could disable it from the Registry. I am using Visio 2003 and
pasting it into power point 2000 sp3.

Any suggestions???


Gary

The default for paste is (as I remember) a bmp image. You might take a look
at the eqivalent powerpoint command to see if you can do a paste special
inside the program and select the format.
al

Thank You!

I have a question of the Paste.

I assume it keeps the OLE Object such that I can still open up Visio in
Power Point??? I am at work and can't try it until tonight.

Gary

I use this to copy visio charts to powerpoint. As you observed moving to
and
from files can add time. If I were going to use this I would probably
query
the data to find out how many records/sheets I needed first, open an
instance of visio (like you have), copy the images to the visio sheet by
first grouping them, and then use the clipboard path rather than a file
path. Rather than ungrouping at the end of the page copy I would delete
the
group so that I had a clean sheet to copy the next image from.
hope it helps,
al

'*********************************************************************

'*********************************************************************

'

' these are the powerpoint functions

' This is setup to copy the components from foreground pages

'

'*********************************************************************

'*********************************************************************



Public Sub subGeneratePowerPoint()

Dim visApp As Visio.Application

Dim visDocument As Visio.Document

Dim visPage As Visio.Page

Dim iObjCtr As Integer

Dim iConCtr As Integer

Dim iPagCtr As Integer

Dim strForeground As String

Dim strBackground As String

Dim shpGroup As Microsoft.Office.Interop.Visio.Shape

Const MAX_SLIDES As Long = 250

Dim lLastSlide As Long

Dim lToCreate As Long = 10

Dim lResult As Long

Dim Continue As Boolean

Dim strResult As String

Try

visDocument = visApp.ActiveDocument

Dim ppApp As PowerPoint.Application

Dim ppPres As PowerPoint.Presentation

Dim ppSlide As PowerPoint.Slide

Dim bAssistantOn As Boolean

'Start Powerpoint and make its window visible but minimized.

ppApp = New PowerPoint.Application

'oApp.Visible = cOffice.msoTrue

ppPres = ppApp.Presentations.Add(cOffice.MsoTriState.msoTrue)

lLastSlide = ppPres.Slides.Count

'first we create the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' we dont want to include the background slides

If visDocument.Pages(iPagCtr).Background = 0 Then

lLastSlide = lLastSlide + CLng(1)

ppPres.Slides.Add(lLastSlide, ppLayoutBlank)

If err.Number <> 0 Then

strResult = "Unable to add new slides " & err.Description

MsgBox(strResult, vbCritical, "Error Adding Slides")

End If ' test for slide being created

End If ' test for background

Next iPagCtr

' now we populate the pages in the presentation

For iPagCtr = 1 To visDocument.Pages.Count

' Debug.Print "powerpoint page " & iPagCtr

strForeground = ""

strBackground = ""

If visDocument.Pages(iPagCtr).Background = False Then

' move page to active window

strForeground = visDocument.Pages(iPagCtr).Name

'If Not (visDocument.Pages(iPagCtr).BackPage Is Nothing) Then

' strBackground = visDocument.Pages(iPagCtr).BackPage

' we can add code here to add background to the slide

' ActiveWindow.Page = strBackground

' but not today

'Else

' strBackground = "NoBackground"

'End If

visApp.ActiveWindow.Page = strForeground

visApp.ActiveWindow.SelectAll()

visApp.ActiveWindow.Group()

shpGroup = visApp.ActivePage.Shapes.Item(visApp.ActivePage.Shapes.Count)

' Debug.Print "powerpoint objects " & ActivePage.Shapes.Count

' copy selected items to clipboard

visApp.ActiveWindow.Copy()

' Debug.Print "copied"

' Paste Visio drawing from the clipboard to Powerpoint correct slide

ppPres.Slides.Item(iPagCtr).Shapes.Paste()

' now paste the page name into the slides footer as a label

ppPres.Slides.Item(iPagCtr).HeadersFooters.Footer.Text = strForeground

System.Windows.Forms.Application.DoEvents()

' Debug.Print "pasted"

' now let's ungroup them

shpGroup.Ungroup()

' Debug.Print "ungrouped"

' deselect the objects so we dont get confused

visApp.ActiveWindow.DeselectAll()

' give the system back some time to get things done

End If

System.Windows.Forms.Application.DoEvents()

Next iPagCtr

Catch err As Exception

subLogException(err)

subDisplayException(Nothing, err)

End Try

End Sub

The access new group suggested for me to post here on the Visio group.
I have an embed Visio drawings in an OLE Object field of a Access
Table.
This allows me to move the drawings around with its data. I need a
program
of taking the embed Visio data and inserting it into power point.

I have a first cut of this, but the program run slow because it first
activate the embed Visio OLE Object and and I save it to a temp file
and
use
an AddOLEObject to add it into power point.

I have a form which is associated with the table that has the Visio
OLEObject. It create a bound object and set the verb = -2 which opens
up
the
Visio separately when I activate the OLEObject. I then saveas the
activated
Visio to the temp file. I noticed that AddOLEObject take a file and
inserts
it.

Here is my code:

Private Sub Command19_Click()
Dim oPPT As PowerPoint.Application
Dim oPres As Presentation
Dim xWidth As Integer, yHeight As Integer

Dim AppVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim db As Database
Dim T As DAO.Recordset

Set db = DBEngine.Workspaces(0).Databases(0)
Set T = db.OpenRecordset("tblLoadOLE")

T.MoveFirst

Set oPPT = New PowerPoint.Application
Set oPres = oPPT.Presentations.Add(True)

Const ppLayoutBlank = 12
Const ppSaveAsPresentation = 1

xWidth = (11 * 1440) / 20
yHeight = (8.5 * 1440) / 20
' yHeight = (6.8 * 1440) / 20

oPres.PageSetup.SlideWidth = xWidth
oPres.PageSetup.SlideHeight = yHeight

Do Until T.EOF
'For i = 1 To 2

Me![OLEFile].Action = acOLEActivate

Set AppVisio = GetObject(, "visio.application")
Set DocObj = AppVisio.ActiveDocument
DocObj.SaveAs "c:\access 2006\MyDrawing.vsd"

AppVisio.Quit
Set AppVisio = Nothing

oPres.Slides.Add(oPres.Slides.Count + 1,
ppLayoutBlank).Shapes.AddOLEObject Left:=0, Top:=0, Width:=xWidth,
Height:=yHeight, FileName:="c:\access 2006\MyDrawing.vsd",
Link:=msoFalse
DoCmd.RunCommand acCmdRecordsGoToNext
T.MoveNext
Loop
'Next i

oPres.SaveAs "c:\access 2006\MyDrawing.ppt", ppSaveAsPresentation,
True

oPres.Close
Set oPres = Nothing
oPPT.Quit