Manipulating an Excel Table from within a PPT Presentation

[epak]

I am trying to manipulate an excel table from within a powerpoint presentation using macros. What I want to be able to do is to change cell colors, copy and paste rows and columns (basically shift rows up and down, and shift columns left and right) and a few other things. But I'm a novice with macros and I keep running into problems.

What I've done is first make a macro manipulating the table from inside excel to test it and then I tried using that macro in the ppt with the "addresses" changed.

Well, to have a look at the excel file with the macro working the way I want it, download this file: sample.xls.

And sample.ppt is trying to do the same thing as the macro in the above table file but from inside a powerpoint presentation (with a table embeded as an object)

Because the whole macro didn't work inside powerpoint, I split parts of the code to see if it worked by itself. I managed to be able to "target" a particular cell inside the embeded table and change the contents. However, changing the cell color does not seem to work. Nor copying and pasting.

For instance, this works:

ActivePresentation.Slides(1).Shapes("Table").OLEFormat.Object.Application.Workbooks(1).Worksheets(1).Cells(2, 4) = "HA"

But this doesn't:

With ActivePresentation.Slides(1).Shapes("Table").OLEFormat.Object.Application.Workbooks(1).Worksheets(1).Cells(2, 5).Interior
        .ColorIndex = 4
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        End With

Well, I'm quite stumped and I would really appreciate some help.

Thanks!


---- Update ----

Someone suggested that I use this revised code:

Sub Sort() 
    Dim i, j, jtmp, itmp 
     
    With ActivePresentation.Slides(1).Shapes("Table").OLEFormat.Object.Application.Workbooks(1).Worksheets(1) 
        For i = 2 To 28 
            For j = 3 To 29 
                If .Cells(i, j) = "x" Then 
                    If j > i Then 
                         
                        With .Cells(i, j).Interior 
                            .ColorIndex = 4 
                            .Pattern = xlSolid 
                            .PatternColorIndex = xlAutomatic 
                        End With 
                         
                        Sleep (500) 
                         
                        With .Cells(i, j).Interior 
                            .ColorIndex = xlNone 
                            .Pattern = xlNone 
                            .PatternColorIndex = xlNone 
                             
                            .Cells(j, 1).EntireRow.Select 
                            .Selection.Insert Shift:=xlDown 
                            .Cells(i, 1).EntireRow.Select 
                            .Selection.Cut 
                            .Cells(j, 1).EntireRow.Select 
                            .Paste 
                            .Cells(i, 1).EntireRow.Select 
                            .Selection.Delete Shift:=xlUp 
                            jtmp = j + 1 
                            .Cells(1, jtmp).EntireColumn.Select 
                            .Selection.Insert Shift:=xlToRight 
                            itmp = i + 1 
                            .Cells(1, itmp).EntireColumn.Select 
                            .Selection.Cut 
                            .Cells(1, jtmp).EntireColumn.Select 
                            .Paste 
                            .Cells(1, itmp).EntireColumn.Select 
                            .Selection.Delete Shift:=xlToLeft 
                        End With 
                    End If 
                End If 
            Next j 
        Next i 
         
    End With 
     
End Sub

But I get a "Run-time error 438: object doesn't support this property or method" error for the following line:

.Cells(j, 1).EntireRow.Select

Does it by any chance have anything to do with references? Not exactly sure what references are but I have enabled "Microsoft Excel 11.0 Object Library".

And I would also like to ask why there is such a susceptible delay when a macro is triggered by clicking on the button? Why isn't it as instantaneous as in from within excel? And more importantly, is it possible to reduce this delay?

[DKenny]

You are almost there.

You need to set a reference to the object property of the Shapes OLEFormat. ( That's really intuitive right? )

Here's a version of your TestColour proc that shows how to create a workbook object variable from the shape. Once you have this Wkb object, you can use any Excel VBA code directly against it.

Sub DKTestColor()
Dim pptExcelHolder As PowerPoint.Shape
Dim wkbEmbBook As Excel.Workbook
Dim wksSheet As Excel.Worksheet
 
    Set pptExcelHolder = ActivePresentation.Slides(1).Shapes("Table")
    Set wkbEmbBook = pptExcelHolder.OLEFormat.Object
    
    Set wksSheet = wkbEmbBook.Worksheets(1)
    
    With wksSheet.Cells(2, 5).Interior
        .ColorIndex = 4
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
 
End Sub

[epak]

That worked!! Thank you so much!

I have just(!) two more questions to ask. (Two problems need to be solved for this macro to work!) Would really appreciate the help!

Updated sample files sample2.ppt, sample2.xls

-----------
Problem #1

Sub cpTest()

    Dim i, j, jtmp, itmp
    Dim pptExcelHolder As PowerPoint.Shape
    Dim wkbEmbBook As Excel.Workbook
    Dim wksSheet As Excel.Worksheet

    Set pptExcelHolder = ActivePresentation.Slides(1).Shapes("Table")
    Set wkbEmbBook = pptExcelHolder.OLEFormat.Object
    Set wksSheet = wkbEmbBook.Worksheets(1)

    wksSheet.Cells(2, 1).EntireRow.Cut
    wksSheet.Cells(3, 1).EntireRow.Select
    wksSheet.Paste
     
End Sub

Cutting the contents of the whole row (or column) and pasting it into another row (or column) doesn't seem to work. Am I right to think it is because you can't exactly "select" in a embeded table/object in a ppt file? How would I get this to work?


-----------
Problem #2

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Test1()

    Dim pptExcelHolder As PowerPoint.Shape
    Dim wkbEmbBook As Excel.Workbook
    Dim wksSheet As Excel.Worksheet

    Set pptExcelHolder = ActivePresentation.Slides(1).Shapes("Table")
    Set wkbEmbBook = pptExcelHolder.OLEFormat.Object
    Set wksSheet = wkbEmbBook.Worksheets(1)
    
    With wksSheet.Cells(2, 5).Interior
        .ColorIndex = 8
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    
    Sleep(5000)
    
    With wksSheet.Cells(2, 5).Interior
        .ColorIndex = 4
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With

End Sub

When I run this macro, the cell color is supposed to turn from white to 8 (and after a pause of 5 seconds) turn to 4. Unfortuantely I only see the end result. The cells remains white until it turns to 4 in 5 seconds time. But I have noticed that if you click on the table (to select it) right after you run the macro, you CAN see the cell turn from white to 8 before changing to 4!

But this is ONLY if you click on the table. So I am thinking that it is because the table doesn't get "refreshed" before the macro ends. Is there a way to force this "refresh"?

[TypingOffKey]

I am trying to do something somewhat similar. It's similar in the fact that I'm trying to manipluate an Excel table from within Powerpoint using Macros, but different in that I'm not actually trying to change any data.

Basically, I've built something of a digital scratch-board in Powerpoint. I've got 50 gray squares that are covering up cells of an Excel object which is generating random dollar values. The problem is that, to be fair, the values should not be known to anyone (including myself) before the scratching happens.

What I would like to be able to do is have a macro within Powerpoint that forces a recalculation of the embedded spreadsheet. Something like

Application.SendKeys "^%{F9}"

would work if i could get it to target just the embedded object.

Any suggestions?

[epak]

I managed to resolve my problem (not being able to see the steps; needing to refresh) by forcing the fille to save. I don't know if this will work for you, but I suppose you could try it.