Opening embedded Excel object with VBA

[JS]

Hi All, I need to programmatically manipulate embedded excel objects in PPT.
I've put a macro together, but I am not able to get the macro to open the
embedded excel object (excel comes up blank). Con someone please tell me
what's wrong?
Thanks in advance, JS
=======================================
Sub a_Open_EmbeddedExcel()
Dim Shp As Shape
Dim Sld As Slide
Dim xlApp As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Set xlApp = New Excel.Application
For Each Sld In Application.ActivePresentation.Slides
For Each Shp In Sld.Shapes
If Shp.Type = msoEmbeddedOLEObject Then
If Shp.OLEFormat.ProgID = "Excel.Sheet.8" Then
Set oWorkbook = Shp.OLEFormat.Object
Set oWorksheet = oWorkbook.ActiveSheet
With xlApp
.Visible = True
oWorksheet.Activate
MsgBox "Did it open the embedded excel object?"
MsgBox "There are " & xlApp.Windows(1).VisibleRange.Cells.Count & "
cells visible"
' if yes,
' MsgBox xlApp.ActiveWindow.VisibleRange.Address
' more excel macro commands here
End With
oWorkbook.Close (True)
Set oWorkbook = Nothing
Set oWorksheet = Nothing
End If 'Shp.Type
End If 'Shp.OLEFormat.ProgID
Next Shp
Next Sld
xlApp.Quit
End Sub

 

[Helmut Weber]

Hi JS,

have a look at this one:

Sub a_Open_EmbeddedExcel()
Dim Shp As Shape
Dim Sld As Slide
For Each Sld In Application.ActivePresentation.Slides
For Each Shp In Sld.Shapes
If Shp.Type = msoEmbeddedOLEObject Then
If Shp.OLEFormat.ProgID = "Excel.Sheet.8" Then
Shp.OLEFormat.Activate
Set objEXL = Shp.OLEFormat.Object
With objEXL.ActiveSheet
.Cells(1, 1).Value = .Cells(1, 1).Value + 1
End With
End If
End If
Next Shp
Next Sld
SendKeys "{ESC}"
End Sub

Only one object required.

See the post above, too:
"Accessing Excel worksheets in a Word document..."

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Doug Robbins - Word MVP]

It would be better to post your question to an Excel of Power Point
Newsgroup. This one is for Word.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP