Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Troubleshooting
Research
Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

edit excel object embedded in PowerPoint via PowerPoint macro

Avatar of theomysh
theomysh asked on
Microsoft PowerPointMicrosoft Applications
8 Comments1 Solution1612 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Avatar of SavindraSingh
SavindraSinghFlag of India image

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Commented:
This problem has been solved!
Unlock 1 Answer and 8 Comments.
See Answers