VBA In Powerpoint "The DoVerb Thingy"

[PSKelligan]

Hello All,

I am trying to get some code to work that acts on an embedded worksheets
from powerpoint. With Steves help, it is mostly working. For some reason I
cannot get it to all come together. The code that follows is in a PPT with
several slides and some of the slides have msoEmbeddedOLEObjects (the
worksheets) and the second proceedure is called to act on the
msoEmbeddedOLEObjects. Can someone tell me where my errors are in this code?

Any help is greatly appreciated!


Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iShpaes As Integer
Dim iOLEShapes As Integer

For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
oSh.Tags.Add "TEST_TAG_NAME", "YadaYadaYada"
' You wanted a count of the shapes so:
iShapes = iShapes + 1
' Is it an OLEembedded thingie?
If oSh.Type = msoEmbeddedOLEObject Then
' Plug in Jon Peltiers's code here
' Increment the counter. Counts based on the if statement.
iOLEShapes = iOLEShapes + 1

'*********This is the code line I get the error on.***************

ActiveWindow.Selection.SlideRange.Shapes("Object 5").Select
ActiveWindow.Selection.ShapeRange.OLEFormat.DoVerb Index:=1
ActiveWindow.Selection.Unselect

'Call the ncmAgeCounter to do it's work
Application.Run "nmcAgeCounter"
End If
Next oSh
Next oSl

' and show the results:
MsgBox "There were " & CStr(i) & " shapes of which " _
& CStr(lOLEShapes) & " were OLE embedded objects."
End Sub

Sub nmcAgeCounter()

Dim briefDate As String
Dim lastCell

briefDate = 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 briefDate = "" 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
ElseIf briefDate < 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

Set lastCell = Range("G65536").End(xlUp)

Columns("G:G").NumberFormat = "0"
Range("G5").FormulaR1C1 = "=IF(RC[-2]<>"""",DATE(2005,4,10)-RC[-2],"""")"
Range("G5").AutoFill Destination:=Range("G5", lastCell),
Type:=xlFillDefault
Range("A1").Select
End Sub

 

[PSKelligan]

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

 

[PSKelligan]

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

 

[PSKelligan]

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

 

[PSKelligan]

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

 

[PSKelligan]

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

 

[PSKelligan]

Hi Steve,
The error message is as follows:

Run-time error '-2147467259 (80004005)':

Meathod 'Object' of object "OLEFormat' failed

Ok... I have played around with this thing a little more and found that Most
of the slides have a an emblem graphic (Top right and left corners) that is
also an msoEmbeddedOLEObject (type 7). The error seems to strike when the
second proceedure runs into one of these since it is trying to access an
excel object. Hmmm... These slides come to me from all over and the obvious
thing would be to put these on the master but I have no control over content
with these. Would it work to set up some exception handling so that if that
particular line failed, control would return to the first proceedure?

'Code follows:

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
Dim briefDate As Date
Dim briefDateInpt As String
Dim strYear As String
Dim strMonth As String
Dim strDay As String

iSlCount = ActivePresentation.Slides.Count

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

' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Request the brief date from the user
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
""m/d/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)

strYear = Year(briefDate)
strMonth = Month(briefDate)
strDay = Day(briefDate)

' 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, strYear, strMonth, strDay)
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
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Sub nmcAgeCounter(oSh As Shape, myYear As String, myMonth As String, myDay
As String)
' Set a VBE reference to Microsoft Excel Object Library

Dim lastCl As Range
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim XLApp As Excel.Application

Set oWorkbook = oSh.OLEFormat.Object

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

With oWorksheet
.Activate
Set 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
End With

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


Thanks,
Patrick

 

[PSKelligan]

Thanks Steve! That did it! I really appreciatre your skill and patience.
Huge thanks and Big Kudos! One more very simple question... I hope. Is
there a statement that is similar to excel's "application.screenupdating =
False"? It would be nice (but not nessecary) to have the program run without
flashing slides.

Thanks again,
Patrick

 

[Bill Foley]

PowerPoint's VBA Equivalent of ScreenUpdating:

http://skp.mvps.org/ppt00033.htm

 

[PSKelligan]

Hi Bill,
That did it for me! I appreiciate the fast response.

Thanks again,
Patrick

 

[Bill Foley]

No problem. Glad to help. As many times as Steve has filled in for me (or
corrected me), it is the least I can do. This way he can get some more
beauty sleep this morning. Isn't that right, Rumple-Steve-Skin?

 

[Bill Foley]

Sorry, don't get it!

 

[Bill Foley]

New to me. Must have been before my time ('58)!