Question : 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!
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
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

Answer : edit excel object embedded in PowerPoint via PowerPoint macro

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:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
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
Random Solutions  
 
programming4us programming4us