VBA In Powerpoint "The DoVerb Thingy"

Hi Steve,
I for some reason was unable to execute the code here from powerpoint.
I should let you know that as of right now this program runns perfectly as
long as I paste the XL proceedure in each of the msoEmbededOLEObjects in the
PPT. Very clumbsy but proves that our code works... So all I need to do is
figure out what I am doing wrong in applying the example code you posted.
I have pasted your code in the same module with my PPT code. I beleive I
have all the references I need. When I run it as below, I get the error:

Run-time error '-2147188160 (80048240)':

Application (unknown member) : Invalid request. Sub or function not defined.

And then PPT locks up and I must end it thru the task manager. See code
below...

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iSlCount As Integer
Dim iSlides As Integer
Dim iShapes As Integer
Dim iOLEShapes As Integer
Dim XLApp As Excel.Application
Dim iOriginalView As Integer

iSlCount = ActivePresentation.Slides.Count

' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType

' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Loop thru and count slides
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1

' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)

' Loop thru, Tag and Count Shapes
For Each oSh In oSl.Shapes
oSh.Tags.Add "SHAPE_NAME", "YadaYadaYada"
iShapes = iShapes + 1

' Loop thru, Count, Activate and run XL proceedure on
msoEmbeddedOLEObjects
If oSh.Type = msoEmbeddedOLEObject Then
iOLEShapes = iOLEShapes + 1
oSh.OLEFormat.DoVerb Index:=1

' Reference existing instance of Excel
Set XLApp = GetObject(, "Excel.Application")

' Call the ncmAgeCounter (so far only way is to have it in
the OLEObject)
'XXXXXXXXXXXXXXX' XLApp.Run "nmcAgeCounter_New_Dating_a"

'XXXXXXXXXXXXXXX' Call Steves example code XXXXXXXXXXXXXX
Application.Run "doWhatever(oSh)"

End If
Next oSh
Next oSl
Set XLApp = Nothing

' Set the view back
ActiveWindow.ViewType = iOriginalView

' Show the results:
MsgBox "There were " & CStr(iSlides) & " slides that held " &
CStr(iShapes) & " shapes of which " _
& CStr(iOLEShapes) & " were OLE embedded objects."
End Sub

Sub DoWhatever(oSh As Shape)
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim oSh As Shape

Dim LastCol As Long
Dim LastRow As Long
Dim x As Long
Dim y As Long

Set oWorkbook = oSh.OLEFormat.Object
' Use the first sheet in the work book
Set oWorksheet = oWorkbook.Worksheets(1)

' Get the last row/col
With oWorksheet
.Activate
' Find the extents of the data in the sheet
LastRow = .Range("a65535").End(xlUp).Row
LastCol = .Range("iv1").End(xlToLeft).Column

' Display the data
For x = 1 To LastRow
For y = 1 To LastCol
Debug.Print "Row" & CStr(x) & ":Col" & CStr(y) & " " &
..Cells(x, y)
Next
Next

End With


See any problems?

Thanks,
Patrick

In article , PSKelligan
wrote:
Hi Steve,
I for some reason was unable to execute the code here from powerpoint.
I should let you know that as of right now this program runns perfectly as
long as I paste the XL proceedure in each of the msoEmbededOLEObjects in the
PPT. Very clumbsy but proves that our code works... So all I need to do is
figure out what I am doing wrong in applying the example code you posted.
I have pasted your code in the same module with my PPT code. I beleive I
have all the references I need. When I run it as below, I get the error:

Run-time error '-2147188160 (80048240)':

Application (unknown member) : Invalid request. Sub or function not defined.

And then PPT locks up and I must end it thru the task manager. See code
below...

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iSlCount As Integer
Dim iSlides As Integer
Dim iShapes As Integer
Dim iOLEShapes As Integer
Dim XLApp As Excel.Application
Dim iOriginalView As Integer

iSlCount = ActivePresentation.Slides.Count

' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType

' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Loop thru and count slides
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1

' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)

' Loop thru, Tag and Count Shapes
For Each oSh In oSl.Shapes
oSh.Tags.Add "SHAPE_NAME", "YadaYadaYada"
iShapes = iShapes + 1

' Loop thru, Count, Activate and run XL proceedure on
msoEmbeddedOLEObjects
If oSh.Type = msoEmbeddedOLEObject Then
iOLEShapes = iOLEShapes + 1

' Comment this out
oSh.OLEFormat.DoVerb Index:=1
' And both these lines
' Reference existing instance of Excel
Set XLApp = GetObject(, "Excel.Application")


' Call the ncmAgeCounter (so far only way is to have it in
the OLEObject)
'XXXXXXXXXXXXXXX' XLApp.Run "nmcAgeCounter_New_Dating_a"


' You don't want to use Application, use:
Call doWhatever(oSh)
'XXXXXXXXXXXXXXX' Call Steves example code XXXXXXXXXXXXXX
Application.Run "doWhatever(oSh)"


End If
Next oSh
Next oSl

' Don't need this:
Set XLApp = Nothing



' Set the view back
ActiveWindow.ViewType = iOriginalView

' Show the results:
MsgBox "There were " & CStr(iSlides) & " slides that held " &
CStr(iShapes) & " shapes of which " _
& CStr(iOLEShapes) & " were OLE embedded objects."
End Sub

Sub DoWhatever(oSh As Shape)
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim oSh As Shape

Dim LastCol As Long
Dim LastRow As Long
Dim x As Long
Dim y As Long

Set oWorkbook = oSh.OLEFormat.Object
' Use the first sheet in the work book
Set oWorksheet = oWorkbook.Worksheets(1)

' Get the last row/col
With oWorksheet
.Activate
' Find the extents of the data in the sheet
LastRow = .Range("a65535").End(xlUp).Row
LastCol = .Range("iv1").End(xlToLeft).Column

' Display the data
For x = 1 To LastRow
For y = 1 To LastCol

' Linebreak may have bunged this so

Debug.Print "Row" & CStr(x) _
& ":Col" & CStr(y) _
& " " & cstr(.Cells(x, y))

Next
Next

End With

See any problems?

Thanks,
Patrick


-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

Hi Steve,
I think I have properly followed you instructions now and it is almost
done. I do not mean to sound like an idiot but I guess if the shoe fits.
lol. There is one part of the second proceedure I cannot reconcile I know
the syntax is good when it is run solely in Excel but not here. It seems all
the Range objects are failing. I will post the code again as I have it now.

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iSlCount As Integer
Dim iSlides As Integer
Dim iShapes As Integer
Dim iOLEShapes As Integer
Dim XLApp As Excel.Application
Dim iOriginalView As Integer

iSlCount = ActivePresentation.Slides.Count

' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType

' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Loop thru and count slides
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1

' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)

' Loop thru, Tag and Count Shapes
For Each oSh In oSl.Shapes
oSh.Tags.Add "SHAPE_NAME", "YadaYadaYada"
iShapes = iShapes + 1

' Loop thru, Count, Activate and run XL proceedure on
msoEmbeddedOLEObjects
If oSh.Type = msoEmbeddedOLEObject Then
iOLEShapes = iOLEShapes + 1

' Call the ncmAgeCounter
Call nmcAgeCounter(oSh)
End If
Next oSh
Next oSl
' Set the view back
ActiveWindow.ViewType = iOriginalView

' Show the results:
MsgBox "There were " & CStr(iSlides) & " slides that held " &
CStr(iShapes) & " shapes of which " _
& CStr(iOLEShapes) & " were OLE embedded objects."
End Sub

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Sub nmcAgeCounter(oSh As Shape)
' Set a VBE reference to Microsoft Excel Object Library

Dim briefDate As Date
Dim briefDateInpt As String
Dim myYear As String
Dim myMonth As String
Dim myDay As String
Dim lastCl As Range
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim LastCol As Long
Dim LastRow As Long
Dim x As Long
Dim y As Long

Dim XLApp As Excel.Application

Set oWorkbook = oSh.OLEFormat.Object

' Use the first sheet in the work book
Set oWorksheet = oWorkbook.Worksheets(1)
briefDateInpt = ""
While Not (IsDate(briefDateInpt))
briefDateInpt = InputBox("Please provide the date that this data
will be briefed." _
& Chr(10) & "format for the briefing date input is
""mm/dd/yyyy"".", _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)")

If Not (IsDate(briefDateInpt)) Then
MsgBox "Please provide valid date.", 16, _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)"
Exit Sub
ElseIf briefDateInpt Date Then
MsgBox "You must provide valid date that" _
& Chr(10) & "is equal to or greater than todays date!" _
& Chr(10) & "This program will close. Please try again.",
16, _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)"
Exit Sub
End If
Wend
briefDate = DateValue(briefDateInpt)

myYear = Year(briefDate)
myMonth = Month(briefDate)
myDay = Day(briefDate)
With oWorksheet
.Activate

' Find the extents of the data in the sheet
LastRow = .Range("G65535").End(xlUp).Row
LastCol = .Range("iv5").End(xlToLeft).Column

'XXXXXX As I fuss with this, the error:
'XXXXXX Run-time error '1004':
'XXXXXX Meathod 'Range' of object '_Global' failed
'XXXXXX I have tried to incorp your "LastRow = " etc...
'XXXXXX but to no avail as I cannot figure out how to apply it
'XXXXXX to this circumstance.
'
' Find the extents of the data in the sheet
' LastRow = .Range("G65535").End(xlUp).Row
' LastCol = .Range("iv5").End(xlToLeft).Column

lastCl = Range("G65536").End(xlUp)
Columns("G:G").NumberFormat = "0"
Range("G5").FormulaR1C1 = "=IF(RC[-2]"""",DATE(" & myYear &
"," & myMonth & "," & myDay & ")-RC[-2],"""")"
Range("G5").AutoFill Destination:=Range("G5", lastCl),
Type:=xlFillDefault
Range("A1").Select
End With


oWorkbook.Close (False)
Set oWorkbook = Nothing
Set oWorksheet = Nothing
End Sub

I really appreciat the patience and education Steve,

Thanks,
Patrick

In article , PSKelligan
wrote:
Hi Steve,
I think I have properly followed you instructions now and it is almost
done. I do not mean to sound like an idiot but I guess if the shoe fits.

A bad fit, I'd say, if you've come this far this fast. g

lol. There is one part of the second proceedure I cannot reconcile I know
the syntax is good when it is run solely in Excel but not here. It seems all
the Range objects are failing. I will post the code again as I have it now.

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iSlCount As Integer
Dim iSlides As Integer
Dim iShapes As Integer
Dim iOLEShapes As Integer
Dim XLApp As Excel.Application
Dim iOriginalView As Integer

iSlCount = ActivePresentation.Slides.Count

' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType

' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Loop thru and count slides
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1

' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)

' Loop thru, Tag and Count Shapes
For Each oSh In oSl.Shapes
oSh.Tags.Add "SHAPE_NAME", "YadaYadaYada"
iShapes = iShapes + 1

' Loop thru, Count, Activate and run XL proceedure on
msoEmbeddedOLEObjects
If oSh.Type = msoEmbeddedOLEObject Then
iOLEShapes = iOLEShapes + 1

' Call the ncmAgeCounter
Call nmcAgeCounter(oSh)
End If
Next oSh
Next oSl
' Set the view back
ActiveWindow.ViewType = iOriginalView

' Show the results:
MsgBox "There were " & CStr(iSlides) & " slides that held " &
CStr(iShapes) & " shapes of which " _
& CStr(iOLEShapes) & " were OLE embedded objects."
End Sub

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Sub nmcAgeCounter(oSh As Shape)
' Set a VBE reference to Microsoft Excel Object Library

Dim briefDate As Date
Dim briefDateInpt As String
Dim myYear As String
Dim myMonth As String
Dim myDay As String
Dim lastCl As Range
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim LastCol As Long
Dim LastRow As Long
Dim x As Long
Dim y As Long

Dim XLApp As Excel.Application

Set oWorkbook = oSh.OLEFormat.Object

' Use the first sheet in the work book
Set oWorksheet = oWorkbook.Worksheets(1)
briefDateInpt = ""
While Not (IsDate(briefDateInpt))
briefDateInpt = InputBox("Please provide the date that this data
will be briefed." _
& Chr(10) & "format for the briefing date input is
""mm/dd/yyyy"".", _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)")

If Not (IsDate(briefDateInpt)) Then
MsgBox "Please provide valid date.", 16, _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)"
Exit Sub
ElseIf briefDateInpt Date Then
MsgBox "You must provide valid date that" _
& Chr(10) & "is equal to or greater than todays date!" _
& Chr(10) & "This program will close. Please try again.",
16, _
"NMC Age Counter (MTC TECHNOLOGIES Inc.)"
Exit Sub

This wouldn't be what's causing problems, but you'll want to do some cleanup in
each case before Exit Sub ... you might instead want to get the info requested,
test it and set a flag to true ... then go about waking up Excel. IOW, I'd get
the user input earlier on. Maybe even as part of the other subroutine and then
pass it to this one as parameters.

End If
Wend
briefDate = DateValue(briefDateInpt)

myYear = Year(briefDate)
myMonth = Month(briefDate)
myDay = Day(briefDate)
With oWorksheet
.Activate

' Find the extents of the data in the sheet
LastRow = .Range("G65535").End(xlUp).Row
LastCol = .Range("iv5").End(xlToLeft).Column

'XXXXXX As I fuss with this, the error:
'XXXXXX Run-time error '1004':
'XXXXXX Meathod 'Range' of object '_Global' failed
'XXXXXX I have tried to incorp your "LastRow = " etc...
'XXXXXX but to no avail as I cannot figure out how to apply it
'XXXXXX to this circumstance.

LastRow/LastCol were just examples; a way to find the last row/col of data in
the sheet in case that's what you needed to know. I don't imagine you do.

'
' Find the extents of the data in the sheet
' LastRow = .Range("G65535").End(xlUp).Row
' LastCol = .Range("iv5").End(xlToLeft).Column


lastCl = Range("G65536").End(xlUp)

Ah. You can't use Range because there's no Range method in PPT.
If you use .Range, the IDE sees it as a method of the WorkSheet object (since
we're in the middle of a With oWorksheet/End With context).

Who'd believe that a couple silly little dots could cause so much grief, eh?
The IDE's Intellisense will help you here though.
Type a period and you'll see the methods and properties that apply to the
Worksheet object you're working with. I'm no excel wiz but my guess is that
you'll want a dot before .Columns, .Range.

Columns("G:G").NumberFormat = "0"
Range("G5").FormulaR1C1 = "=IF(RC[-2]"""",DATE(" & myYear &
"," & myMonth & "," & myDay & ")-RC[-2],"""")"
Range("G5").AutoFill Destination:=Range("G5", lastCl),
Type:=xlFillDefault
Range("A1").Select
End With


oWorkbook.Close (False)
Set oWorkbook = Nothing
Set oWorksheet = Nothing
End Sub

I really appreciat the patience and education Steve,

We're having fun yet, right? ;-)


-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

A bad fit, I'd say, if you've come this far this fast. g

Thanks!


This wouldn't be what's causing problems, but you'll want to do some cleanup in
each case before Exit Sub ... you might instead want to get the info requested,
test it and set a flag to true ... then go about waking up Excel. IOW, I'd get
the user input earlier on. Maybe even as part of the other subroutine and then
pass it to this one as parameters.

Sounds good. I'll make the changes.

Who'd believe that a couple silly little dots could cause so much grief, eh?
The IDE's Intellisense will help you here though.
Type a period and you'll see the methods and properties that apply to the
Worksheet object you're working with. I'm no excel wiz but my guess is that
you'll want a dot before .Columns, .Range.

That was it! Those pesky little Dots!

Huge thanks Steve!
Truly a Guru!

V/R,
Patrick

Uggggghhh!
So I thought I was done... Well, when I tried to set it up as an add-in it
did not work. Got the Run-time error, "Method 'Object' of 'OLEFormat'
failed" on the line: "Set oWorkbook = oSh.OLEFormat.Object" in the second
proceedure. Checked my refrences and the settings are the same as my test
presentation that I was using to build this thing. So I try it on the real
deal also, by pasting it in a module on the Actual presentation... Same
error. Any idea why that would be?

Thanks,
Patrick

Hi Steve,
Ok it seems it will work as long as there is only ine msoEmbededOLEObject
in the presentation as there was in my test presentation. The program fails
however on the afore mentioned line on the second atempt to run the second
proceedure. Any thoughts?

Thanks,
Patrick

That was it! Those pesky little Dots!

Excellent!


Huge thanks Steve!
Truly a Guru!

Not really ... but I know where the real ones live. ;-)

-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

In article , PSKelligan
wrote:
Uggggghhh!
So I thought I was done... Well, when I tried to set it up as an add-in it
did not work. Got the Run-time error, "Method 'Object' of 'OLEFormat'
failed" on the line: "Set oWorkbook = oSh.OLEFormat.Object" in the second
proceedure. Checked my refrences and the settings are the same as my test
presentation that I was using to build this thing. So I try it on the real
deal also, by pasting it in a module on the Actual presentation... Same
error. Any idea why that would be?

Did you remember to add a reference to the MS Excel Object Library (tools,
references)? That has to be done for each project.



-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

Did you remember to add a reference to the MS Excel Object Library (tools,
references)? That has to be done for each project.

Yes... See the other post I submitted just above the the one you replied to.
I did them one after the other and it stacked them in the wrong order... or
rather I will just re-paste it here. lol.

Hi Steve,
Ok it seems it will work as long as there is only ine msoEmbededOLEObject
in the presentation as there was in my test presentation. The program fails
however on the afore mentioned line on the second atempt to run the second
proceedure. Any thoughts?

Thanks,
Patrick