Creating PPT pres with Excel objects

[Jan Vente]

Hi list,

I've an Excel workbook with a macro wich creates a powerpointpresentation
with a slide for everey worksheet. In de slides the procedure creates an
Excel OLE object with the values of the worksheets of the workbook. At the
end the procedure starts the slide-show.
Without starting the slideshow, the everything works fine. But with it the
OLE object isn't filled with the values.

Thanks, Jan Vente

code:

Sub CreateShow()
'Variable for every worksheet in the workbook
Dim objWS As Worksheet

'Variables for creating the presentation with the ole-objects
Dim objPApp As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
Dim objSld As PowerPoint.Slide
Dim objShp As PowerPoint.Shape

'Variables for the loop of the Excel ranges
Dim objCell As Object
Dim strAdres As String

'Variables for a reference to the Excel oleobject. Use in loop
Dim objOLEwb As Excel.Workbook
Dim objOLEws As Excel.Worksheet

'Starting powerpoint en creating the presentation
Set objPApp = New PowerPoint.Application
objPApp.Visible = True
Set objPres = objPApp.Presentations.Add(msoTrue)

'Loop: for every worksheet a slide is made with an ole-object
For Each objWS In Application.Workbooks("ole.xls").Sheets
Set objSld = objPres.Slides.Add(Index:=objWS.Index,
Layout:=ppLayoutTitleOnly)
objSld.SlideShowTransition.AdvanceOnTime = True
objSld.SlideShowTransition.AdvanceTime = 1
objSld.Shapes("Rectangle 2").TextFrame.TextRange.Text = objWS.Name

Set objShp = objSld.Shapes.AddOLEObject(Left:=20, Top:=120, Width:=480,
Height:=320, classname:="Excel.sheet.8")
'A reference to the worksheet in the OLE object
Set objOLEwb = objShp.OLEFormat.Object
Set objOLEws = objOLEwb.ActiveSheet

'Every cell in the OLE object gets the value of the cell of the Excel
workbook
For Each objCell In objWS.Range("a1").CurrentRegion
strAdres = objCell.Address
objOLEws.Range(strAdres).Value = objCell.Value
Next objCell
Next objWS

Set objCell = Nothing
Set objOLEws = Nothing
Set objOLEwb = Nothing
Set objShp = Nothing
Set objSld = Nothing
Set objWS = Nothing

'Starting the slideshow
With objPres.SlideShowSettings
.LoopUntilStopped = True
.Run
End With

set objPApp = Nothing
set objPres = Nothing

Application.ActiveWindow.WindowState = xlMaximized
End Sub