Excel VBA to refresh power point slides

[azahi]

I am new to VBA and wondering if some one can help me. I have written Vba codes which creates power point slides by taking data and charts from the excel . i am using excel 2010 and power point 2010.
The code is working ok, the issue i am facing is the pictures are not pasted in the middle of the slides. All the shapes are pasted on the top left hand corner.
Below is my codes any help will be appreciated. i have tried different methods but i am definitely missing very important point. Also one more thing, some time when i run the code, not both of them get updated but when i refresh again two or three times it gets updated.


Sub creatpp()

Dim myppt As PowerPoint.Application
Set myppt = New PowerPoint.Application
myppt.Visible = msoCTrueActiveSheet.Shapes.Range(Array("Object 4")).Select Selection.Verb Verb:=xlOpen

Dim mypres As PowerPoint.Presentation
Set mypres = myppt.ActivePresentation
Dim mySlide1 As PowerPoint.Slide
Dim mySlide4 As PowerPoint.Slide
Set mySlide1 = mypres.Slides(1)
Set mySlide4 = mypres.Slides(4)
Dim wb As WorkbookSet wb = ActiveWorkbookwb.Activate

wb.Sheets("Slides").Visible = xlSheetVisible
wb.Sheets("Slides").Range("A12:G20").Copy


' Slide 1 Copy and paste next range
myppt.Activate
On Error Resume Next
For Each Shape In mySlide1.Shapes
If Shape.Type = msoPicture Then
Shape.Delete
End If
Next
mySlide1.Shapes.PasteSpecial ppPasteMetafilePicture

'With PPPres.Slides(1)
'.Shapes.Paste
'With myslides1.Shapes(Shapes.Count)
'.LockAspectRatio = msoTrue
'.Left = 25
'.Top = 100
'.Height = 300
'End With



'Slide 4 Copy and paste next range
wb.Sheets("Slides").Range("A112:F118").Copy
myppt.Activate
On Error Resume Next
For Each Shape In mySlide4.Shapes
If Shape.Type = msoPicture Then
Shape.Delete

End If
Next
mySlide4.Shapes.PasteSpecial ppPasteMetafilePicture



Application.ErrorCheckingOptions.NumberAsText = False

wb.Sheets("Slides").Visible = xlSheetVeryHidden

End Sub<strike></strike>

 

[Worf]

Welcome to the Forum

' Excel module
Sub creatpp()
Dim myppt As PowerPoint.Application, wb As Workbook, shp As PowerPoint.Shape
Dim mypres As Presentation, mySlide1 As Slide, mySlide4 As Slide
Set myppt = New PowerPoint.Application
myppt.Visible = msoCTrue
ActiveSheet.Shapes.Range(Array("Object 1")).Select
Selection.Verb Verb:=xlOpen
Set mypres = myppt.ActivePresentation
mypres.Slides.Add Index:=mypres.Slides.Count + 1, Layout:=ppLayoutCustom
Set mySlide1 = mypres.Slides(1)
Set mySlide4 = mypres.Slides(2)
Set wb = ActiveWorkbook
wb.Activate
wb.Sheets("Slides").Visible = xlSheetVisible
wb.Sheets("Slides").[A12:G20].Copy
myppt.Activate
For Each shp In mySlide1.Shapes
    If shp.Type = msoPicture Then shp.Delete
Next
mySlide1.Shapes.PasteSpecial ppPasteMetafilePicture
With mySlide1.Shapes(mySlide1.Shapes.Count)
    .LockAspectRatio = msoTrue
    .Left = (mypres.PageSetup.SlideWidth - .Width) / 2      ' center
    .Top = (mypres.PageSetup.SlideHeight - .Height) / 2
End With
wb.Sheets("Slides").[A112:F118].Copy
myppt.Activate
For Each shp In mySlide4.Shapes
    If shp.Type = msoPicture Then shp.Delete
Next
mySlide4.Shapes.PasteSpecial ppPasteMetafilePicture
With mySlide4.Shapes(mySlide4.Shapes.Count)
    .Top = (mypres.PageSetup.SlideHeight - .Height) / 2
    .Left = (mypres.PageSetup.SlideWidth - .Width) / 2
End With
Application.ErrorCheckingOptions.NumberAsText = False
DoEvents
End Sub