Visio Sheets to Powerpoint help

[Cruzs75]

I am looking for some help in setting up my VBA code from Visio. I currently have it setup to take the current active sheet on Visio, open up a powerpoint presentation. Copy all of the information on the visio sheet and paste as an ehanced meta file to Powerpoint. Then the EMF is positioned coincedent with the top left corner and given a width to what seems to creates an image that fills the page. I have two questions that I can't seem to figure out in VBA code.

Question 1: How do I alter my code to place the EMF file centered vertically on the slide when it is pasted instead of placing it in the top left corner.

Question 2: I have multiple visio sheets that I would like to bring in to Powerpoint. How do I set up the 'for' loop to cycle through all the visio pages, copy their content and EMF paste onto a new blank slide.

I am pretty new to VBA coding and most of what I have below I was able to decipher from similar applications. But I can not seem to find much VBA coding for Visio to Powerpoint applications.

Any help would be grateful

Sub Copy_to_powerpoint()
'Keyboard Shortcut: Ctrl Shift + T
'
Dim PPT As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Set PPT = New PowerPoint.Application

' Creates a new Power Point presentation
If PPT Is Nothing Then
Set PPT = New PowerPoint.Application
End If

' Make a presentation in PowerPoint
If PPT.Presentations.Count = 0 Then
PPT.Presentations.Add
End If

PPT.Visible = True

Application.ActiveWindow.SelectAll
ActiveWindow.DeselectAll
Application.ActiveWindow.Selection.Copy
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, ppLayoutBlank
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
Set activeSlide = PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count)

'Adjust the positioning of the Chart on Powerpoint Slide
PPT.ActiveWindow.Selection.ShapeRange.Left = 0
PPT.ActiveWindow.Selection.ShapeRange.Top = 0
PPT.ActiveWindow.Selection.ShapeRange.Width = 700

End Sub


Thanks,
Steven

[Johncoltrane]

Hi, you are using VBA script to power point. Instead why dont you use power point tools that are available in market. They also provide great easy to use and have many short cuts.

[John Wilson]

Instead of:
PPT.ActiveWindow.Selection.ShapeRange.Left = 0
PPT.ActiveWindow.Selection.ShapeRange.Top = 0
PPT.ActiveWindow.Selection.ShapeRange.Width = 700

Use:
With PPT.ActiveWindow.Selection.ShapeRange
.Width = 700
.Align 1, msoTrue
.Align 4, msoTrue
End With