Link to home
Start Free TrialLog in
Avatar of theomysh
theomysh

asked on

edit excel object embedded in PowerPoint via PowerPoint macro

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

ASKER CERTIFIED SOLUTION
Avatar of SavindraSingh
SavindraSingh
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I forgot to mention:
Please remember to add reference to Microsoft Excel 12.0 object Librery.
Avatar of theomysh
theomysh

ASKER

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

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

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
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

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