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(x lLastCell) .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!
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(x
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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:
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
ASKER
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
example.ppt
ASKER
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
ASKER
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
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
Please remember to add reference to Microsoft Excel 12.0 object Librery.