VBA In Powerpoint "The DoVerb Thingy"

[Guest]

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

 

[Steve Rindsberg]

See below ...

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

At this point, you may not have anything selected, so Select will give you an
error. It's more error-prone in general and slows things down. Best avoided
when possible. Try replacing the 3 lines above with:

oSh.OLEFormat.DoVerb Index:=1

Is nmcAgeCounter stored in the XLS? As written, it'd pretty much need to be.
Otherwise it'll take a bit more footwork to make it fly from w/in PPT.

'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

 

[Steve Rindsberg]

Hi Steve,
I tried running the code line you provided but get the following error :

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

OLEFormat (unknown member) : Invalid request. The window must be in slide
or notes view.

Any ideas?

Not a one. But quote back the section of code we're talking about here and I
might. ;-)

Ah, wait. We're at the point where you're activating the OLE shape, right?
PPT would bark at you if you were in, say, Slide Sorter view at that point.
Your code will need to put it in slide view instead.

Try surrounding your code like so:

Dim lOriginalView as Long
' Remember the view you're in now
lOriginalView = ActiveWindow.ViewType
' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

' Do your stuff here

' Set the view back
ActiveWindow.ViewType = lOriginalView

 

[Steve Rindsberg]

Hi Steve,
Yes, I was hoping to be able to store that second proceedure in PPT (the
same module as the first one).

You can do that but you'll need to study up some more on automating one app from
another. Jon's site should have some more on that.

I'd trust his examples over anything I'm likely to come up with off top of head.

If I store it in Excel can it be in the
PERSONAL.xls workbook? Does PERSONAL.xls open when the msoEmbededOLEObect is
activated just as it opens in the background for ony other workbook?

I don't know offhand. I'm not that familiar with Excel.
Try it. Drop

Msgbox("I tried it. Myself. It works.") in there and let it rock.

 

[Steve Rindsberg]

Hi Steve,
Ok Here is where I am at now. first here is my code to include some
attemps that I have commented out for debugging.

See comments inserted below:

This first proceedure is in a PPT module:

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iShapes As Long
Dim iOLEShapes As Long
Dim XLApp As Excel.Application
Dim lOriginalView As Long

' Remember the view you're in now
lOriginalView = ActiveWindow.ViewType
' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

For Each oSl In ActivePresentation.Slides

' ADD THIS - should solve the problem with the error message
ActiveWindow.View.GoToSlide(oSl.SlideIndex)

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
' Can only paste into slide view
' Application.ActiveWindow.ViewType = ppViewSlide
' Activating the msoEmbeddedOLEObject
' Reference active slide
' Set PPSlide = ActivePresentation.Slides _
' (Application.ActiveWindow.Selection.SlideRange.SlideIndex)

' oSh.OLEFormat.DoVerb Index:=1

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

'Call the ncmAgeCounter to do it's work

' Rather than calling a procedure from w/in the XLS, I'd bring it all into PPT
' That might solve other problems as well

' XLApp.Run "nmcAgeCounter"

call nmcAgeCounter(osh)

End If
Next oSh
Next oSl
Set XLApp = Nothing

' Set the view back
ActiveWindow.ViewType = lOriginalView

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

This second proceedure is in both the PERSONAL.xls book (would not run from
there although PERSONAL.xls did open when the OLEObject was activated) and
the embedded msoEmbeddedOLEObject module. (Sometimes it starts up and
sometimes it does not but it never finishes):

You'll need to rewrite nmcAgeCounter in PPT.
See the section of Jon's page called:
Paste a Selected Excel Worksheet Range into the Active PowerPoint Slide
(PowerPoint VBA)
for more specifics

 

[Steve Rindsberg]

Hey Patrick,

In addition to my earlier reply, have another look here:

Automate Excel from PowerPoint. Automate PowerPoint from Excel. And so on.
http://www.rdpslides.com/pptfaq/FAQ00368.htm

I've added a simple swat of example code that demos how you can activate an
embedded worksheet and retrieve data from it, all from w/in PPT.

You could modify the code to a sub that does something like this:

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

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

End Sub

Hi Steve,
Ok Here is where I am at now. first here is my code to include some
attemps that I have commented out for debugging.

This first proceedure is in a PPT module:

Sub Tag_n_Enumerate_Shapes()

Dim oSl As Slide
Dim oSh As Shape
Dim iShapes As Long
Dim iOLEShapes As Long
Dim XLApp As Excel.Application
Dim lOriginalView As Long

' Remember the view you're in now
lOriginalView = ActiveWindow.ViewType
' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide

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
' Can only paste into slide view
' Application.ActiveWindow.ViewType = ppViewSlide
' Activating the msoEmbeddedOLEObject
' Reference active slide
' Set PPSlide = ActivePresentation.Slides _
' (Application.ActiveWindow.Selection.SlideRange.SlideIndex)

oSh.OLEFormat.DoVerb Index:=1

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

'Call the ncmAgeCounter to do it's work
XLApp.Run "nmcAgeCounter"
End If
Next oSh
Next oSl
Set XLApp = Nothing

' Set the view back
ActiveWindow.ViewType = lOriginalView

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

This second proceedure is in both the PERSONAL.xls book (would not run from
there although PERSONAL.xls did open when the OLEObject was activated) and
the embedded msoEmbeddedOLEObject module. (Sometimes it starts up and
sometimes it does not but it never finishes):

Sub nmcAgeCounter()

Dim briefDate As String
Dim lastCl As Range

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 "Please provide valid date.", 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 lastCl = 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", lastCl), Type:=xlFillDefault
Range("A1").Select
End Sub

As I step into this code I get the following error even with your code
ammendments regarding slide view.

Run-time error '-2147188160 (80048240)':
OLEFormat (unknown member) : Invalid request. The window must be in slide
or notes view.

If I check the actual view, I can see that you ammendments did take she
screen to slide view. If however I manually select the slide that holds my
first msoEmbededOLEObject, The code works on it but will give me the same
error as it tries to go to the next OLEObject on the next slide. Also the
Shape/OLEObject count is no longer working?? lol.

Thanks,
Patrick

 

[Steve Rindsberg]

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))

 

[Guest]

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

 

[Steve Rindsberg]

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

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? ;-)

 

[Guest]

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

 

[Guest]

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

 

[Guest]

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

 

[Steve Rindsberg]

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]

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.

 

[Guest]

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

 

[Steve Rindsberg]

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. ;-)

 

[Guest]

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

 

[Steve Rindsberg]

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

 

[Guest]

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