Dim ppApp As PowerPoint.Application
    Dim prsPres As Presentation
    Dim shpGraph As Shape
    Dim prsSld As Slide
    Dim prsShp  As Shape
    Dim oGraph As Object
    Dim oDataSheet As Object
    Dim prsHeadFoot As HeaderFooter
    Dim Index As Integer
    Dim Ws As Worksheet, Wb As Workbook

    Public Sub Main1()
    On Error Resume Next
 
    Set ppApp = New PowerPoint.Application
    ppApp.Visible = msoTrue
    Set prsPres = ppApp.Presentations.Open(CurDir + "\" + "Byte.ppt")
    For Each prsSld In prsPres.Slides
         For Index = 1 To prsSld.Shapes.Count
            With prsSld.Shapes(Index)
'                If .HasTextFrame = msoTrue Then Debug.Print 
' .TextFrame.TextRange.Text
                If .Type = msoEmbeddedOLEObject Then
                    Debug.Print .OLEFormat.ProgId
                    Set Wb = .OLEFormat.Object
                    Set Ws = Wb.Sheets(2)
                    Debug.Print Ws.Cells(1, 2)
                    Debug.Print Wb.Name
                    Debug.Print .Name
'                      .Name = "Object 1"
                ElseIf .Type = msoTextBox Then
                    Debug.Print .Name & "=" & .TextFrame.TextRange.Text
'                    Debug.Print .Name
'                      .Name = "Text Box " & Index
                ElseIf .Type = msoGroup Then
                    Debug.Print "Group=" & .Name
                Else
                    Debug.Print .Type & "=" & .Name
'                    Debug.Print .Name
                End If
             End With
        Next Index
     Next prsSld
End Sub
<pre><code>

Gru? Wastl