Capture Value of Excel OLE shape and store in Variable

[out2thow]

Hey All,

I'm trying to grab the value of an embedded object (by Excel cell value link - paste special) and can't seem to find the correct procedure.

I have a dynamic Excel file (Cells auto update every 60 seconds) linked in my PPT file.

An action button triggers the following macro to write the value in a shape as text. The goal here is to calculate (sum) up some values, so I will be capturing several fields over different times.

Variable Score is Public at start of module.

Sub FM1()

Score = ActivePresentation.SlideShowWindow.View.Slide.Shapes("P11").OLEFormat.Object.Value
ActivePresentation.SlideShowWindow.View.Slide.Shapes("FMScore").TextFrame.TextRange.Text = Score


End Sub

I'm using Office 2010.

Any help would be greatly appreciated.
Thank you very much.

[John Wilson]

I think you would need to deduce the sheet and cell from the link address and check the value in Excel.

Something like this, treat with care as it is untested and I cannot see you slide!

Sub read_XL()
Dim oshp As Shape
Dim XLaddress As String
Dim rayAddress() As String
Dim oxl As Object
Dim owb As Object
Dim iRow As Integer
Dim ipos As Integer
Dim iCol As Integer
Dim osheet As Object
Set oshp = SlideShowWindows(1).View.Slide.Shapes("P11")
XLaddress = oshp.LinkFormat.SourceFullName
rayAddress = Split(XLaddress, "!")
ipos = InStr(rayAddress(2), "C")
iRow = CInt(Mid(rayAddress(2), 2, ipos - 2))
iCol = CInt(Mid(rayAddress(2), ipos + 1))
Set oxl = CreateObject(Class:="Excel.Application")
Set owb = oxl.Workbooks.Open(rayAddress(0)) ' assumes file is not open
'' you could also check all open files to find it
MsgBox owb.Sheets(1).Cells(iRow, iCol).Value
oxl.Quit
End Sub

[out2thow]

Thanks John,

This far exceeds my VBA skills, but works great. The only issue I have is the delay, on my system, it takes about 5 seconds to update. Is there any way to speed this up?

Thanks again!

I think you would need to deduce the sheet and cell from the link address and check the value in Excel.

Something like this, treat with care as it is untested and I cannot see you slide!

Sub read_XL()
Dim oshp As Shape
Dim XLaddress As String
Dim rayAddress() As String
Dim oxl As Object
Dim owb As Object
Dim iRow As Integer
Dim ipos As Integer
Dim iCol As Integer
Dim osheet As Object
Set oshp = SlideShowWindows(1).View.Slide.Shapes("P11")
XLaddress = oshp.LinkFormat.SourceFullName
rayAddress = Split(XLaddress, "!")
ipos = InStr(rayAddress(2), "C")
iRow = CInt(Mid(rayAddress(2), 2, ipos - 2))
iCol = CInt(Mid(rayAddress(2), ipos + 1))
Set oxl = CreateObject(Class:="Excel.Application")
Set owb = oxl.Workbooks.Open(rayAddress(0)) ' assumes file is not open
'' you could also check all open files to find it
MsgBox owb.Sheets(1).Cells(iRow, iCol).Value
oxl.Quit
End Sub

[John Wilson]

It's slow because it is opening the Excel file.

If you have the file open it will be much quicker but be aware it will read the current value which may not be the sam as the value in PPT if the link has not been updated.

Sub chexXL()
Dim oshp As Shape
Dim XLaddress As String
Dim rayAddress() As String
Dim oxl As Object
Dim owb As Object
Dim iRow As Integer
Dim ipos As Integer
Dim iCol As Integer
Dim osheet As Object
Dim i As Integer
Dim b_close As Boolean
Set oshp = SlideShowWindows(1).View.Slide.Shapes("P11")
XLaddress = oshp.LinkFormat.SourceFullName
rayAddress = Split(XLaddress, "!")
ipos = InStr(rayAddress(2), "C")
iRow = CInt(Mid(rayAddress(2), 2, ipos - 2))
iCol = CInt(Mid(rayAddress(2), ipos + 1))
On Error Resume Next
Err.Clear
Set oxl = GetObject(Class:="Excel.Application")
If oxl Is Nothing Then
MsgBox "Excel is not open"
Exit Sub
End If
For i = 1 To oxl.workbooks.Count
If oxl.workbooks(i).FullName = rayAddress(0) Then Set owb = oxl.workbooks(i)
Next i
If owb Is Nothing Then
MsgBox "File not found"
Exit Sub
End If
MsgBox owb.Sheets(rayAddress(1)).Cells(iRow, iCol).Value
End Sub