edit excel object embedded in PowerPoint via PowerPoint macro

theomysh
theomysh used Ask the Experts™
on
Hello Experts,

I have a Powerpoint macro that passes through every selected object on a slide to perform a "replace" procedure on text boxes, on data grids in graphs and on word art objects.

Now,  I have to perform the same type of function on an embedded Excel object. Given this macro is in Powerpoint, it complicates this a bit for me and I can't quite figure out what to do.

What kind of object definition do I need to do to be able to perform the equivalent of:
1. double click on the excel object to "activate it"
2. then perform the equivalent of "ActiveCell.SpecialCells(xlLastCell).Select"
3. then go over every cell between "A1" and "xlLastCell" to perform a replace function and do validation tests.

I have attached the code I currently am using, the code I am trying to created will be placed in between the two rows of "'*********************************************"

Thanks for your help!
Sub ChangeTagComplexe(StrRch() As String, TypObj As Integer)
'with selected graphs, macro runs through each datasheet of each graph and determines how many rows and columns are included in graph
'asteric chain is where we will add the replace function to perform a replace on each cell in the datasheet of the graph
    
'TypObj = 1 = selected objects
'TypObj = 2 = all objects
'TypObj = 3 = graph
'TypObj = 4 = textbox
'TypObj = 5 = wordart
'TypObj = 6 = Excel Object

  ' Object variables
    Dim oGraphChart As Object
    Dim oDatasheet As Object
    Dim oSh As Shape

    ' Misc variables
    Dim lCol As Long
    Dim lRow As Long
    Dim LastCol As Long
    Dim LastRow As Long
    Dim X As Long
    Dim C, CC, CCC As Long
    Dim MaxRows As Long
    Dim MaxColumns As Long
    Dim Nom_Obj() As String
    
    C = ActiveWindow.Selection.ShapeRange.Count

    ReDim Nom_Obj(C + 1)
    For CC = 1 To C
        Nom_Obj(CC) = ActiveWindow.Selection.ShapeRange(CC).Name
    Next CC
    
    For CC = 1 To C
    'for each object on slide
        ActiveWindow.Selection.SlideRange.Shapes.SelectAll
        ActiveWindow.Selection.ShapeRange(Nom_Obj(CC)).Select
        Set oSh = ActiveWindow.Selection.ShapeRange(1)
        
        If oSh.Type = msoEmbeddedOLEObject And (TypObj = 1 Or TypObj = 2) Then
            'edit datagrid in graph
            MaxRows = 100
            MaxColumns = 100
        
            Set oGraphChart = oSh.OLEFormat.Object
            Set oDatasheet = oGraphChart.Application.datasheet
            With oDatasheet
                
                ' Find LastRow
                For X = 1 To MaxRows
                    If .Rows(X).Include Then
                        LastRow = X
                    End If
                Next X
                ' Find LastCol
                For X = 1 To MaxColumns
                    If .Columns(X).Include Then
                        LastCol = X
                    End If
                Next X
                ' Fill in the data
                For lCol = 0 To LastCol - 1
                   For lRow = 0 To LastRow - 1
                        If lCol = 0 Then
                            For CCC = 1 To 25
                                If CStr(StrRch(CCC, 1)) <> "" Then
                                    If FrmTagRepl.CaseTrue = True Then
                                        .Range("0" & CStr(lRow)).Value = Replace(.Range("0" & CStr(lRow)).Value, StrRch(CCC, 1), StrRch(CCC, 2))
                                    Else
                                        .Range("0" & CStr(lRow)).Value = Replace(.Range("0" & CStr(lRow)).Value, StrRch(CCC, 1), StrRch(CCC, 2), , , vbTextCompare)
                                    End If
                                End If
                            Next CCC
                        Else
                            For CCC = 1 To 25
                                If CStr(StrRch(CCC, 1)) <> "" Then
                                    If FrmTagRepl.CaseTrue = True Then
                                        .Range(Chr(96 + lCol) & CStr(lRow)).Value = Replace(.Range(Chr(96 + lCol) & CStr(lRow)).Value, StrRch(CCC, 1), StrRch(CCC, 2))
                                    Else
                                        .Range(Chr(96 + lCol) & CStr(lRow)).Value = Replace(.Range(Chr(96 + lCol) & CStr(lRow)).Value, StrRch(CCC, 1), StrRch(CCC, 2), , , vbTextCompare)
                                    End If
                                End If
                            Next CCC
                        End If
                   Next lRow
                Next lCol
            End With
         oSh.OLEFormat.DoVerb Index:=1
         'ActiveWindow.Selection.SlideRange.Shapes.SelectAll
            ActivePresentation.Save
            'end edit datagrid in graph
            oGraphChart.Application.Quit
        
        ElseIf (oSh.Type = msoTextBox Or oSh.Type = msoPlaceholder Or oSh.Type = 1) And (TypObj = 1 Or TypObj = 3) Then
            'edit text box
            For CCC = 1 To 25
                If CStr(StrRch(CCC, 1)) <> "" Then
                    If FrmTagRepl.CaseTrue = True Then
                        oSh.TextFrame.TextRange.Text = Replace(oSh.TextFrame.TextRange.Text, StrRch(CCC, 1), StrRch(CCC, 2))
                    Else
                        oSh.TextFrame.TextRange.Text = Replace(oSh.TextFrame.TextRange.Text, StrRch(CCC, 1), StrRch(CCC, 2), , , vbTextCompare)
                    End If
                End If
            Next CCC
        ElseIf oSh.Type = msoTextEffect And (TypObj = 1 Or TypObj = 4) Then
            For CCC = 1 To 25
                If CStr(StrRch(CCC, 1)) <> "" Then
                    If FrmTagRepl.CaseTrue = True Then
                        oSh.TextEffect.Text = Replace(oSh.TextEffect.Text, StrRch(CCC, 1), StrRch(CCC, 2))
                    Else
                        oSh.TextEffect.Text = Replace(oSh.TextEffect.Text, StrRch(CCC, 1), StrRch(CCC, 2), , , vbTextCompare)
                    End If
                End If
            Next CCC
        ElseIf oSh.Type = 6 And (TypObj = 1) Then
            '*********************************************
            'code needed here to edit embedded Excel object
            '1: determine the last column and row of active sheet
            '2: go over each cell and perform replace function
            '*********************************************
        End If
    Next CC

End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
The above code has been modified to find the last column and last row in the excel sheet. But I could not find the defination for below variable/object within the code you have provided.

FrmTagRepl

Rest of the code is provided below:
Code to find last column and last row:
MaxRows = oSh.OLEFormat.Object.Sheets(1).Cells(oSh.OLEFormat.Object.Sheets(1).Cells.Rows.Count, 1).End(xlUp).Row
MaxColumns = oSh.OLEFormat.Object.Sheets(1).Cells(1, oSh.OLEFormat.Object.Sheets(1).Cells.Columns.Count).End(xlToLeft).Column
LastCellAddress = oSh.OLEFormat.Object.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address

'*************************************************
'* Code to replace values on Embeded excel Sheet *  
'*************************************************
Dim TrgetRange As Excel.Range

Dim TrgetRange As Excel.Range
Set TrgetRange = oSh.OLEFormat.Object.Sheets(1).Range("A1:" & LastCellAddress)

For Each Cell In TrgetRange
    Cell.Value = "The value you want to replace with!"
Next

Open in new window

I forgot to mention:
Please remember to add reference to Microsoft Excel 12.0 object Librery.

Author

Commented:
Thanks Savindra,

I added a reference to Excel 11.0 Library, but there are still bugs...

The first is that my Osh.Type = msoGroup (integer value of 6), so when we make any reference to "oSh.OLEFormat...." I get the error...

"OLEFormat (unknown member) : Invalid request. This prooperty only applies to OLE objects"

What should I use as reference?

Thanks

How to Generate Services Revenue the Easiest Way

This Tuesday! Learn key insights about modern cyber protection services & gain practical strategies to skyrocket business:

- What it takes to build a cloud service portfolio
- How to determine which services will help your unique business grow
- Various use-cases and examples

The code I have provided works when the Embeded object is detected as an excel object. That means, when below condition is true:

If oSh.Type = msoEmbeddedOLEObject And (TypObj = 1 Or TypObj = 2)

When the target object is found as an Excel object , the above condition proves true and then you can use below code:


MaxRows = oSh.OLEFormat.Object.Sheets(1).Cells(oSh.OLEFormat.Object.Sheets(1).Cells.Rows.Count, 1).End(xlUp).Row
MaxColumns = oSh.OLEFormat.Object.Sheets(1).Cells(1, oSh.OLEFormat.Object.Sheets(1).Cells.Columns.Count).End(xlToLeft).Column
LastCellAddress = oSh.OLEFormat.Object.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address

'*************************************************
'* Code to replace values on Embeded excel Sheet *  
'*************************************************
Dim TrgetRange As Excel.Range

Dim TrgetRange As Excel.Range
Set TrgetRange = oSh.OLEFormat.Object.Sheets(1).Range("A1:" & LastCellAddress)

For Each Cell In TrgetRange
    Cell.Value = "The value you want to replace with!"
Next

Open in new window

Author

Commented:
I already have a solution for ole objects. I need a solution for an excel object that is type msoGroup, I have attached a file with the object...
example.ppt

Author

Commented:
Wait, now that I am retrying this, the same object is comming up msoEnbeddedObject, I will test this and get back to you.
I had just tested the code on the example worksheet provided by you and it is working fine.
Sub test()
Dim oSh As Shape
Dim Nom_Obj() As String
Dim TrgetRange As Excel.Range
TypObj = 2

ActiveWindow.Selection.SlideRange.Shapes.SelectAll

C = ActiveWindow.Selection.ShapeRange.Count
ReDim Nom_Obj(C + 1)
    For CC = 1 To C
        Nom_Obj(CC) = ActiveWindow.Selection.ShapeRange(CC).Name
    Next CC
    
    For CC = 1 To C
        ActiveWindow.Selection.SlideRange.Shapes.SelectAll
        ActiveWindow.Selection.ShapeRange(Nom_Obj(CC)).Select
        Set oSh = ActiveWindow.Selection.ShapeRange(1)
        
        
        If oSh.Type = msoEmbeddedOLEObject And (TypObj = 1 Or TypObj = 2) Then
            LastCellAddress = oSh.OLEFormat.Object.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address
            Set TrgetRange = oSh.OLEFormat.Object.Sheets(1).Range("A1:" & LastCellAddress)
            MaxRows = oSh.OLEFormat.Object.Sheets(1).Cells(oSh.OLEFormat.Object.Sheets(1).Cells.Rows.Count, 1).End(xlUp).Row
            MaxColumns = oSh.OLEFormat.Object.Sheets(1).Cells(1, oSh.OLEFormat.Object.Sheets(1).Cells.Columns.Count).End(xlToLeft).Column
            Counter = 1
            For Each Cell In TrgetRange
                Cell.Value = "Test-" & Counter
                Counter = Counter + 1
            Next
        End If
    Next
End Sub

Open in new window

Author

Commented:
Thanks SavindraSingh,

The issue I was having with your code was because my excel object was grouped with a jpg image. Your code works perfectly now.

Thanks

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial