VBA - make view active?

[Geoff Cox]

Hello,

The code below works OK except that I would like to show the slide
with this button on it.

I have tried using

If oSh.AutoShapeType = 130 Then
oSh.Select
MsgBox "end button found"

but get error message re "its view must be active". How do I make it
active?


Thanks

Geoff


For Each oSh In oSl.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then
MsgBox "end button found"
End If
End If
Next oSh
Next oSl

 

[John Wilson]

Hi Geoff

I take it the presentation being searched is actually open in edit mode?

Also type 130 (its 132 I think) is not an end show button but as any action
can be assigned to any button or shape this isnt the way to do it
Try

Sub geoff()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.ActionSettings(ppMouseClick).Action = ppActionEndShow Then
MsgBox ("found it")
osld.Select
'maybe Exit Sub here
End If
Next oshp
Next osld
End Sub
--
I think I would also do an Exit Sub after the selection to jump out of the
loops.

Did that answer the question / help?
_____________________________
John Wilson
Microsoft Certified Office Specialist
http://www.technologytrish.co.uk/ppttipshome.html

 

[Geoff Cox]

Hi Geoff

I take it the presentation being searched is actually open in edit mode?

Also type 130 (its 132 I think) is not an end show button but as any action
can be assigned to any button or shape this isnt the way to do it
Try

Sub geoff()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.ActionSettings(ppMouseClick).Action = ppActionEndShow Then
MsgBox ("found it")
osld.Select
'maybe Exit Sub here
End If
Next oshp
Next osld
End Sub

Thanks John - will give this a whirl soon and get back to you.

Cheers

Geoff

 

[Geoff Cox]

If you're in slide show view, nothing can be selected, so any attempt in code
to select something will *always* cause an error.

To select a shape, you need to be in edit view.

Maybe something like:

If oSh.AutoShapeType = 130 then
SlideShowWindows(1).View.GoToSlide(oSh.Parent.SlideIndex)
End if

Thanks Steve - will try this out and get back.

Cheers

Geoff

 

[Geoff Cox]

SlideShowWindows(1).View.GoToSlide(oSh.Parent.SlideIndex)

Steve,

The full code for the sub is below and uses your line above. I get
error message "SlideShowWindows(unknown number): Integer out of range.
1 is not in the valid range 1 to 0"

Any thoughts?

Cheers

Geoff


Sub check_for_button(strMyFile As String)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim oSl As Slide

For Each oSl In ActivePresentation.Slides

Dim oSh As shape

For Each oSh In oSl.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then
SlideShowWindows(1).View.GotoSlide (oSh.Parent.SlideIndex)
MsgBox "end button found"
End If
End If
Next oSh
Next oSl
oPresentation.Close

End With

Set oSh = Nothing
Set oPresentation = Nothing

End Sub

 

[John Wilson]

Can you clarify Geoff. Are you in slide show mode or edit mode?

 

[Geoff Cox]

Can you clarify Geoff. Are you in slide show mode or edit mode?

John,

I am not sure what you mean!

I run the macro from within PowerPoint and the macro works on all the
ppt files in a folder and its sub-folders.

How do I know whether this is slide show or edit mode?

Cheers

Geoff

 

[John Wilson]

If you open .ppt files then theyre in edit mode (I think!)

slideshowwindows(1) will only work in slideshow mode as there is no
slideshowwindow open in edit mode

Also as I said before to find action buttons or shapes with an action of
"end show" I dont think that you can use type 130 (which is just an action
button) but must use something that detects the actual action e.g
If oshp.ActionSettings(ppMouseClick).Action = ppActionEndShow Then

Did you try my original code?
--

Did that answer the question / help?
_____________________________
John Wilson
Microsoft Certified Office Specialist
http://www.technologytrish.co.uk/ppttipshome.html

 

[Geoff Cox]

Steve and John,

By guess and by God have got code below to work!

The crucial difference is

ActiveWindow.View.GotoSlide (oSl.SlideIndex)

which presumably puts me in edit mode?

Cheers

Geoff



Sub check_for_button(strMyFile As String)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim oSl As Slide

For Each oSl In ActivePresentation.Slides

ActiveWindow.View.GotoSlide (oSl.SlideIndex)

Dim oSh As shape

For Each oSh In oSl.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then

oSh.Select
MsgBox "end button found in slide " & oSl.SlideIndex
End If
End If
Next oSh
Next oSl
oPresentation.Close

End With

Set oSh = Nothing
Set oPresentation = Nothing

End Sub

 

[Geoff Cox]

No, but it works if you ARE in edit mode (aka Normal View or Slide View, as
opposed to SlideShow view)

OK I get it!

Thanks

Geoff

 

[Geoff Cox]

On Fri, 29 Sep 2006 17:23:35 EDT, Steve Rindsberg


Steve,

Having found the action button which is type 130 the code below will
change its shape to that for 132 but the line

oSh.ActionSettings(ppMouseClick).Action = ppEndShow

only seems to remove the hyperlink rather than change it to End Show.

I am trying to put together your code ideas with John's and falling
down the middle I guess?!

John's code is not working for me yet..

Cheers

Geoff

For Each oSh In oSl.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then

oSh.AutoShapeType = 132
oSh.ActionSettings(ppMouseClick).Action = ppEndShow

'oSh.Select
'MsgBox "end button found in slide " & oSl.SlideIndex
End If
End If
Next oSh
Next oSl

 

[Geoff Cox]

If you open .ppt files then theyre in edit mode (I think!)

slideshowwindows(1) will only work in slideshow mode as there is no
slideshowwindow open in edit mode

Also as I said before to find action buttons or shapes with an action of
"end show" I dont think that you can use type 130 (which is just an action
button) but must use something that detects the actual action e.g
If oshp.ActionSettings(ppMouseClick).Action = ppActionEndShow Then

Did you try my original code?

John,

I now see the difference bewteen the shape of the button and its
action. I would like to change any ForwardOrNext buttons to EndShow
buttons.

My code based on yours is giving me multiple "found it"s on slides
where there are no buttons so I must have made a mistake in the code -
can you see where?

Cheers

Geoff

Sub check_for_button(strMyFile As String)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim osld As Slide
Dim oshp As shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.ActionSettings(ppMouseClick).Action = _
ppForwardOrNext Then
MsgBox ("found it") & " slide " & osld.SlideIndex
osld.Select

'maybe Exit Sub here

End If
Next oshp
Next osld

oPresentation.Save
oPresentation.Close

End With

Set oshp = Nothing
Set osld = Nothing
Set oPresentation = Nothing

End Sub

 

[Geoff Cox]

That should be ppActionEndShow
With that change it works here

Streve,

Thanks for above. Odd thing is that if I run the code simply to find
and select the type 130 button, all the buttons are found.

When I remove the message line and the select but add the

oSh.AutoShapeType = 132
oSh.ActionSettings(ppMouseClick).Action = ppActionEndShow

all of the shapes are changed to the 132 type but not all of the
hyperlinks are changed to End Show.

Any ideas please? Full code below.

Geoff

Sub search_for_button_steve()

Set fs = Application.FileSearch
With fs
.LookIn = "C:\test\activities\"
.SearchSubFolders = True
.FileName = "*.ppt"
If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count

check_for_button (.FoundFiles(i))

Next i
Else
MsgBox "There were no files found."
End If
End With

End Sub

Sub check_for_button(strMyFile As String)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim oSl As Slide

For Each oSl In ActivePresentation.Slides

ActiveWindow.View.GotoSlide (oSl.SlideIndex)

Dim oSh As shape

For Each oSh In oSl.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then

oSh.AutoShapeType = 132
oSh.ActionSettings(ppMouseClick).Action = ppActionEndShow

'oSh.Select
'MsgBox "end button found in slide " & oSl.SlideIndex
End If
End If
Next oSh
Next oSl
oPresentation.Save
oPresentation.Close

End With

Set oSh = Nothing
Set oPresentation = Nothing

End Sub

 

[Geoff Cox]

Not sure why that should be, unless some of the shapes are non-Autoshapes.

Steve,

the code wouldn't find and select the buttons if they were not
Autoshapes, would it?

ActivePresentation may not always be the one you just opened (oPresentation)
Make that

For Each oSl in oPresentation

When I try this I get error message "Object doesn't support this
property or method" ?!

Cheers

Geoff

 

[Geoff Cox]

oSh.ActionSettings(ppMouseClick).Hyperlink.Delete

Steve,

Excellent! Thanks a million!

There's an old Yorkshire saying, "Everything comes to them as waits"!

I was thinking of deleting the button and recreating it but held off -
didn't want to throw too many questionstoo quickly at you both!

Just thought of another old saying - which sometimes applies to me I
think - the man who got on a horse and rode off in all directions!

I have added the working code below.

If I had wanted to recreate the button after deleting it how would
that be done?

If oSh.AutoShapeType = 130 Then
oSh.delete

then what?

Cheers

Geoff

PS still no book around specifically on VBA for PowerPoint? I do have
David M's book but would love to see one just on the coding itself -
there seem to be lots on Excel and Access but not PPT...


Sub search_for_button_sr()

'code finds all ppt files in c:\test\ and any sub-folders

Set fs = Application.FileSearch
With fs
.LookIn = "C:\test\"
.SearchSubFolders = True
.FileName = "*.ppt"
If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count

'Debug.Print .FoundFiles(i)

check_for_button (.FoundFiles(i))

Next i
Else
MsgBox "There were no files found."
End If
End With

End Sub

Sub check_for_button(strMyFile As String)

'sub finds any type 1 / type 130 action buttons (ForwardOrNext)
'and changes them to 132 (End Show)
'also deletes the current hyperlink and changes it
'it to End Show


Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim oSl As Slide

For Each oSl In ActivePresentation.Slides
'For Each oSl In oPresentation

ActiveWindow.View.GotoSlide (oSl.SlideIndex)

Dim oSh As shape
Dim oHl As Hyperlink


For Each oSh In oSl.Shapes
If oSh.Type = 1 Then

If oSh.AutoShapeType = 130 Then

If oSh.TextFrame.TextRange.Text <> "Classroom notes" _
Then

oSh.ActionSettings(ppMouseClick).Hyperlink.Delete
oSh.ActionSettings(ppMouseClick).Action = _
ppActionEndShow
oSh.AutoShapeType = 132

'oSh.Select
'MsgBox "end button found in slide " & oSl.SlideIndex
'MsgBox _
oSh.ActionSettings(ppMouseClick).Hyperlink.Address

End If

End If

End If

Next oSh
Next oSl

oPresentation.Save
oPresentation.Close

End With

Set oSh = Nothing
Set oPresentation = Nothing

End Sub

 

[Shyam Pillai]

That's really weird and I cannot reproduce it. I would've thought that the
action setting was applied to the text. Since the action setting applied to
text and shape can be distinct, that would explain why end show was failing.


--
Regards,
Shyam Pillai

Animation Carbon
http://www.animationcarbon.com

 

[Geoff Cox]

Simplest is to start by recording a macro as you add the button and set action
settings.

Then modify it. It'll look like

ActiveWindow.Selection.SlideRange.Shapes.AddShape(yada,yada,,,).Select

You'd change that to:

Set oSh = oSl.Shapes.AddShape(all,the,same,yada,yada)

Then modify the properties of oSh as needed

Steve,

had almost forgotten about the recording facility!

Thanks

Geoff

 

[Geoff Cox]

That's a very good question, so I just pulled up the files again to verify.

There's no action setting or hyperlink applied to the text; only to the action
button itself.

I can't reproduce it here either other than using Geoff's file.

With Geoff's permission, I'll send a copy along, if you like.

Steve,

No problem at all - I was just about offer to do that myself!

Cheers

Geoff

 

[Geoff Cox]

Thanks, Geoff. I've sent the files along to Shyam.

OK Steve - 'look forward to hearing what he makes of this!

Cheers

Geoff