Is there a way to convert visio file to powerpoint file?

[Berengere]

I want to send to some big visio files to some people who do not have visio.
So I'd like to convert them in a powerpoint file.

Doing that by Insert / object does not work because vision file have several
pages
Ctrl+A / ctrl+V in pwt works but it takes a lot of time !!

Thanks for your help

 

[Al Edlund]

It can be done fairly easily with a visio macro. You might also consider
having them use the free visio viewer or save as svg (a viewer is available
from adobe for free).
al

 

[Berengere]

I had already tried the visio viewer, but it can not be installed on the
receiver's machine.
I think it will be the same thing for the svg file (as you cannot see it in
acrobat reader).

So I try the macro ... do you mean a macro in visio, which select all
shapes, make a ctrl+C and then paste it in powerpoint ? I have tried to do
something like this, but with no success. Can you tell me a little more about
that macro?

Thanks again

 

[Al Edlund]

you don't use the adobe pdf viewer to read an svg file there is a separate
svg viewer.

http://www.adobe.com/svg/viewer/install/main.html

'*********************************************************************
'*********************************************************************
'
' these are the powerpoint functions
' This is setup to copy the components from foreground pages
' do not forget to reference the powerpoint com object
'
'*********************************************************************
'*********************************************************************


Public Sub subGeneratePowerPoint()

Dim visDocument As Visio.Document
Dim visPage As Visio.Page

Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim iObjCtr As Integer
Dim iConCtr As Integer
Dim iPagCtr As Integer
Dim strForeground As String
Dim strBackground As String
Dim shpGroup As Visio.Shape

Const MAX_SLIDES As Long = 250
Const DEFAULT_AUTO_LAYOUT As Long = ppLayoutBlank
Dim lLastSlide As Long
lLastSlide = 1
Dim lToCreate As Long
lToCreate = 10
Dim lResult As Long
Dim Continue As Boolean
Dim strResult As String

On Error GoTo powerpoint_err
Err.Clear

Set visDocument = Visio.ActiveDocument

' start powerpoint
Set ppApp = New PowerPoint.Application
' make it visible
ppApp.Visible = True
' create the presentation
Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Add(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 = False Then
lLastSlide = lLastSlide + 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
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
ActiveWindow.Page = strForeground
ActiveWindow.SelectAll

' select everything on the page
ActiveWindow.Group

Set shpGroup = ActivePage.Shapes.item(ActivePage.Shapes.Count)
' Debug.Print "powerpoint objects " & ActivePage.Shapes.Count
' copy selected items to clipboard
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
' give the system some time to catch up
DoEvents
' Debug.Print "pasted"
' now let's ungroup them
shpGroup.Ungroup
' Debug.Print "ungrouped"
' deselect the objects so we dont get confused
ActiveWindow.DeselectAll
' give the system back some time to get things done again
DoEvents
End If
Next iPagCtr

powerpoint_exit:
Exit Sub

powerpoint_err:

If Err <> 0 Then
Debug.Print "Error in powerpoint " & Err & " " & Err.Description
Err.Clear
Resume Next
End If


End Sub


al