VBA In Powerpoint "The DoVerb Thingy"

In article , PSKelligan
wrote:
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?

Not offhand, but quote the exact error msg and pop the code in again.
Ever onward. ;-)


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

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
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXX

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

In article , PSKelligan
wrote:
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.

OK. I'm bending over. Kick. Hard. I deserve it. ;-)

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?

Exception handling is always a Good Thing but better is to head the problem off
at the pass. See below:


'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



' Here's where we add another test
' ProgID will tell you what app and in some cases what version of the app
' created the object
' Normally in your case, it'll be Excel.Sheet.N where N = the XL version
' Since we don't care too much about version, we test to see if just
' Excel.Sheet is part of ProgID:
If Instr(oSh.OLEFormat.ProgID,"Excel.Sheet") 0 Then
' Call the ncmAgeCounter
Call nmcAgeCounter(oSh, strYear, strMonth, strDay)
End If


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
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXX

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


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

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

PowerPoint's VBA Equivalent of ScreenUpdating:

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

--
Bill Foley, Microsoft MVP (PowerPoint)
Microsoft Office Specialist Master Instructor - XP
www.pttinc.com
Check out PPT FAQs at: http://www.rdpslides.com/pptfaq/
Check out Word FAQs at: http://word.mvps.org/FAQs/General/index.htm

"PSKelligan" wrote in message
...
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

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

Thanks again,
Patrick

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, Microsoft MVP (PowerPoint)
Microsoft Office Specialist Master Instructor - XP
www.pttinc.com
Check out PPT FAQs at: http://www.rdpslides.com/pptfaq/
Check out Word FAQs at: http://word.mvps.org/FAQs/General/index.htm

"PSKelligan" wrote in message
...
Hi Bill,
That did it for me! I appreiciate the fast response.

Thanks again,
Patrick

In article , PSKelligan
wrote:
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.

There's a Windows API call to prevent updating the window.
I think Shyam's got an example on ... hold on ... yup, here 'tis:

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

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

In article , Bill Foley wrote:
PowerPoint's VBA Equivalent of ScreenUpdating:

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


But your real name is Mister Earl? ;-)

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

Sorry, don't get it!

--
Bill Foley, Microsoft MVP (PowerPoint)
Microsoft Office Specialist Master Instructor - XP
www.pttinc.com
Check out PPT FAQs at: http://www.rdpslides.com/pptfaq/
Check out Word FAQs at: http://word.mvps.org/FAQs/General/index.htm

"Steve Rindsberg" wrote in message
...
In article , Bill Foley wrote:
PowerPoint's VBA Equivalent of ScreenUpdating:

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


But your real name is Mister Earl? ;-)

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