I have a macro that is supposed to make every shape on a page visible (I have other macros that make them invisible). Here is the code:
Dim Slide As Integer
Slide = SSW.View.CurrentShowPosition
If Slide = 1 Then
For Each shp In ActivePresentation.Slides(2).Shapes
shp.Visible = True
Next shp
End if
This macro takes forever to run. I suspect this is because it is redrawing the screen every time a shape is made visible.
This is not necessary, in fact the slide isn't even shown on the screen when this macro is run (it runs on Slide 1 but makes the shapes on Slide 2 visible). Is there any way to make this run faster? Disable the screen refresh or something?
I tried Shyam's solution from http://www.vbaexpress.com/forum/showthread.php?33671-Solved-PP2010-ScreenUpdating-False but it doesn't work. His only goes up to 2010 and I'm using 2013.
Your code doesn't work as shown. I changed it to this, which works pretty much instantly on a slide with 175 shapes:
' Put this at the top of every module; builds character, keeps you out of trouble
Option Explicit
Sub ThisWorks()
' Always dim ALL variables
Dim Slide As Long ' SlideIndex is a Long, not an Integer
Dim oSh As Shape
' Replaced your SSW with this:
Slide = SlideShowWindows(1).View.CurrentShowPosition
If Slide = 1 Then
For Each oSh In ActivePresentation.Slides(2).Shapes
' I was toggling them back and forth as a test
' oSh.Visible = Not oSh.Visible
oSh.Visible = True
Next
End If
' Delete this when it's no longer needed
MsgBox "Done"
End Sub
Related
After clicking Next, I want to run some code before the next slide becomes visible on screen. The code will control some third-party software. This will take between 1 and 3 seconds to complete. In an ideal world, the previous slide's content would remain visible while the code is running and then PowerPoint would advance to the next slide.
I have used PowerPoint's Application.SlideShowNextSlide event using the 'Application Object Events' method described here: http://youpresent.co.uk/powerpoint-application-events-in-vba/ This works, the event triggers as expected.
Despite the documentation saying:
Occurs immediately before the transition to the next slide
...my tests suggest that the code runs after the slide is displayed. Using the test code below, this is what I see on my screen:
The next slide is displayed together with all its content
After approximately 1 second, all content is hidden
After about 5 seconds, all content becomes visible
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
' Checking this works before spending time on the desired functionality
' Will Select/Case (.SlideID) to ensure code runs on the correct slide
Dim oSld As Slide
Dim oShp As Shape
Dim stoptime As Date
Set oSld = Wn.View.Slide
' Test #6: See if hiding the slide's content, running the code, and
' then revealing it is a solution. Unfortunately, all the content is
' already visible before this loop is executed.
'
For Each oShp In oSld.Shapes
oShp.Visible = False
Next
' Waste time (code would go here)
'
stoptime = Now() + #12:00:05 AM#
Do Until Now() > stoptime
DoEvents
Loop
' Reveal content of the slide
'
For Each oShp In oSld.Shapes
oShp.Visible = True
Next
End Sub
I've tried the Sleep API instead of a loop. I've tried making a WScript.Shell call with bWaitOnReturn = true. Neither prevents the content of the slide being rendered before/while the code is being executed.
It is possible to stop the old slide being replaced by the new one until some code has run? Or, stop the content of the next slide being seen while a code block does its job?
Okay. I've made something that works well enough for my needs. It isn't perfect but I'm putting it here in case it acts as a good starting point for others:
The important thing for me is that code must run immediately before the slide is displayed. It's not good enough to run code some seconds prior. This would be apparent to the audience.
So, the key to this is that in the App_SlideShowNextClick event, the passed variable nEffect is Nothing when there are no animations left to complete on that slide. Testing for that alerts you to the point where PowerPoint is about to move to the next slide. Running code at this point, and finishing it with
ActivePresentation.SlideShowWindow.View.Next to trigger the move, works for me.
This is what I did:
Set-up the 'Application Object Events' method of triggering events (see original question for more on this)
Add something unnecessary (e.g., text) within the slide before the one you need code to have been run before it's displayed
[Colour|Color] or bury it such that it won't bother your audience
Add an animation effect to it e.g., 'Disappear'
Ensure this animation is the final animation on this slide
Design some way of knowing when you want the code to run (e.g., using SlideID)
' Module variable
Private mGoingForward As Boolean
Private mPreviousSlideNumber as Integer
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
' In which direction is the user moving through the slideshow?
' This is used in App_SlideShowNextClick
'
mGoingForward = Wn.View.Slide.SlideNumber > mPreviousSlideNumber
End Sub
Private Sub App_SlideShowNextClick(ByVal Wn As SlideShowWindow, ByVal nEffect As Effect)
' nEffect is nothing when there are no further effects to
' perform on the current slide i.e., it's about to move to
' the next slide
'
If nEffect Is Nothing Then
' This is the last time we are going to be on this slide, so update this
'
mPreviousSlideNumber = Wn.View.Slide.SlideNumber
' We are now at the very end of the current slide. The next click will
' move you to the next slide
'
If [ condition when you want the code to run e.g., Wn.View.Slide.SlideID ] Then
' Run your code here
' If necessary, use something like the following to delay execution
' until everything's done
'Dim oShell As Object
'Dim waitOnReturn As Boolean: waitOnReturn = True
'Dim windowStyle As Integer: windowStyle = 0
'oShell.Run cmd, windowStyle, waitOnReturn
' In my situation, I don't have to consider when a user
' moves backwards in the presentation. However, if you don't
' do something like this, you'll never be able to move back. It may
' be possible to possible to detect this without relying on a
' module variable
'
If mGoingForward Then ActivePresentation.SlideShowWindow.View.Next
End If
End If
End Sub
I have a PPT presentation with some slides. In each slide I have some superposed images and some buttons (see example image).
I would like to "bring to front" an image when the corresponding button is clicked.
I have been triying with animations, but unfortunately there is no animation to run this action.
After some 'investigation' I think that the only way to achieve that is by a macro.
I have absolutely no experience in VBA programming, but after some search I found out the way to 'bring to front' an image of the active slide by doing:
Sub Bring_front()
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
sld.Shapes("NUCLEI").ZOrder msoBringToFront
End Sub`
Then I insert an action (to execute the macro) to the correspoding button and everything works fine!
The problem is that in my real presentation I have many images and buttons (like 10 for slide)... and I would like to create a macro with if/else statements in order to run an statement if a button is clicked.
I have also been searching how to do that but I have not been able to get it.
Is it possible to do something like that?:
Sub Bring_front()
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
if Greenbutton is clicked Then
sld.Shapes("GREEN_IMAGE").ZOrder msoBringToFront
elseif Redbutton is clicked Then
sld.Shapes("RED_IMAGE").ZOrder msoBringToFront
elseif Bluebutton is clicked Then
sld.Shapes("BLUE_IMAGE").ZOrder msoBringToFront
end
End Sub
Can someone help me with this, please?
Thank you in advance!
Maria
It's actually quite simple:
Add a new module in the VBA editor and paste this into it:
Sub MoveToTop(oSh As Shape)
Call oSh.ZOrder(msoBringToFront)
End Sub
Then assign this MoveToTop macro as an action setting on each of the shapes you want to be able to adjust.
That's it.
Well, almost. If you're on a Mac and find that this doesn't work, it's because some things in the Mac version of PPT are broken. In that case, try this, which should work ok in Windows versions of PPT also:
Sub MoveToTop(oSh as Shape)
Dim oSl as Slide
Dim oShTemp as Shape
' oSh.Parent returns a valid reference to the shape's host slide:
Set oSl = ActivePresentation.Slides(oSh.Parent.SlideIndex)
' and oSh.Name works:
MsgBox oSh.Name
' So we use those two bits to get a reference
' to the clicked shape like so
Set oShTemp = oSl.Shapes(oSh.Name)
Call oShTemp.ZOrder(msoBringToFront)
End Sub
I need a button in a PowerPoint slide that when I click it, it will, 1) run a macro and 2) hyperlink to another slide within the same presentation.
I can only see a way to do one or the other, not both at the same time.
My macro code is:
Sub question1_real()
Dim oSh As Shape
Dim oSl As Slide
Dim lScore As Long
' By doing it this way it's easy to change to a different slide if you
' need to later for some reason:
Set oSl = ActivePresentation.Slides(18)
' Change this if your shape is named something else:
Set oSh = oSl.Shapes("TextBox 2")
With oSh
' Make sure it's not blank to start with:
If Len(.TextFrame.TextRange.Text) = 0 Then
.TextFrame.TextRange.Text = "1"
End If
lScore = CLng(.TextFrame.TextRange.Text)
lScore = lScore + 1
.TextFrame.TextRange.Text = CStr(lScore)
End With
End Sub
My VBA skills are zero. The above code is borrowed from someone. I used the Insert Action option in PowerPoint to get it to work.
Assuming that you've given a shape a Run Macro action setting and chosen the subroutine you've posted above, you can add this function to the VBA project:
Sub JumpTo(lSlideIndex As Long)
SlideShowWindows(1).View.GoToSlide (lSlideIndex)
End Sub
Then wherever you want to jump to another slide, call it like so:
Call JumpTo(42) ' or whatever slide you want to jump to
or just
JumpTo 42
It's more convenient to have this in a Function if you need to use it more than once in the presentation. If it's strictly a one-shot, you can just paste this into your existing code:
SlideShowWindows(1).View.GoToSlide (42)
For all of you, people who make ppt slides with animations like:
Showing bullet points one by one
Showing images one by one or zooming a plot
Showing a border on an active element
Internal navigation / menu / link to another slide
Transitions between slides
Is there a tool that can convert the ppt to PDF and keep each animation in a separate slide, for example?
I know you can create animated slides with LaTeX Beamer that convert nicely to PDF, I have made some of those, but I also have some ppt files that I want to convert to PDF.
This is what I have tried so far:
Slideshare, however not only it doesn't support animations, but internal navigation doesn't work, and the fonts are all messed up.
PDFcreator, the quality is quite superior in comparison, but it doesn't support the animations neither. As Slideshare, it will just put one image over the other. Also, it doesn't support transparency (for example, a text box with a semitransparent bg over an image)
LaTeX Beamer, already mentioned, but I would prefer to avoid typing these ppts content and animations into LaTeX just so that the animations are displayed correctly in PDF.
I have searched SO and didn't find a satisfactory answer to deal with animations. What do you use?
I found a small plugin that splits your powerpoint slides whenever they have animations. So if you have 3 animations on 1 slide he will generate 3 slides with each animation step by step. Then export it in PDF :-)
It worked for me on powerpoint 2010. I would recommend you do a backup file of presentation before splitting. And don't forget to uncheck the "Split on click-triggered animations".
http://www.dia.uniroma3.it/~rimondin/downloads.php
I also found this (but the first solution was free and worked so :-))
http://www.verypdf.com/wordpress/201306/how-to-create-a-pdf-from-powerpoint-with-animations-36850.html
This blog post provides a VBA macro script that will split every slide that has animations (e.g. images or bullet points that appear one by one) into multiple slides, and then you can save as PDF and voila!
Importantly, since it's a VBA script it should work both for Windows and Mac. I've only tried it on OSX (yosemite) with powerpoint 2011, and it worked pretty well. The only issue I had was that slides with animated bullet points (that appear one by one) were split into multiple slides but every slide contained all the bullet points, so I had to delete some manually. Still, for everything else it worked perfectly and it's a small price to pay compared to doing it all manually, especially image animations. Of course you may/may not encounter the same issue on Windows or other versions of PP. In any case, for OSX it's the only working solution I've found so far.
Instructions for adding VBA macros to powerpoint can be found here.
Hope it works for you too!
This blog post provides a VBA macro script that will split every slide that has animations into multiple slides, without keeping the original slides in front of the expanded slides (as is the case in this answer).
The problem that remains with this macro and the other macro, is that the content of a text block with multiple animations is always shown as a whole (e.g. if each sentence of the same text block has a separate animation, all sentences will always be shown together).
VBA Code:
Private AnimVisibilityTag As String
Sub ExpandAnimations()
AnimVisibilityTag = "AnimationExpandVisibility"
Dim pres As Presentation
Dim Slidenum As Integer
Set pres = ActivePresentation
Slidenum = 1
Do While Slidenum <= pres.Slides.Count
Dim s As Slide
Dim animationCount As Integer
Set s = pres.Slides.Item(Slidenum)
If s.TimeLine.MainSequence.Count > 0 Then
Set s = pres.Slides.Item(Slidenum)
PrepareSlideForAnimationExpansion s
animationCount = expandAnimationsForSlide(pres, s)
Else
animationCount = 1
End If
Slidenum = Slidenum + animationCount
Loop
End Sub
Private Sub PrepareSlideForAnimationExpansion(s As Slide)
' Set visibility tags on all shapes
For Each oShape In s.Shapes
oShape.Tags.Add AnimVisibilityTag, "true"
Next oShape
' Find initial visibility of each shape
For animIdx = s.TimeLine.MainSequence.Count To 1 Step -1
Dim seq As Effect
Set seq = s.TimeLine.MainSequence.Item(animIdx)
On Error GoTo UnknownEffect
For behaviourIdx = seq.Behaviors.Count To 1 Step -1
Dim behavior As AnimationBehavior
Set behavior = seq.Behaviors.Item(behaviourIdx)
If behavior.Type = msoAnimTypeSet Then
If behavior.SetEffect.Property = msoAnimVisibility Then
If behavior.SetEffect.To <> 0 Then
seq.Shape.Tags.Delete AnimVisibilityTag
seq.Shape.Tags.Add AnimVisibilityTag, "false"
Else
seq.Shape.Tags.Delete AnimVisibilityTag
seq.Shape.Tags.Add AnimVisibilityTag, "true"
End If
End If
End If
Next behaviourIdx
NextSequence:
On Error GoTo 0
Next animIdx
Exit Sub
UnknownEffect:
MsgBox ("Encountered an error while calculating object visibility: " + Err.Description)
Resume NextSequence
End Sub
Private Function expandAnimationsForSlide(pres As Presentation, s As Slide) As Integer
Dim numSlides As Integer
numSlides = 1
' Play the animation back to determine visibility
Do While True
' Stop when animation is over or we hit a click trigger
If s.TimeLine.MainSequence.Count <= 0 Then Exit Do
Dim fx As Effect
Set fx = s.TimeLine.MainSequence.Item(1)
If fx.Timing.TriggerType = msoAnimTriggerOnPageClick Then Exit Do
' Play the animation
PlayAnimationEffect fx
fx.Delete
Loop
' Make a copy of the slide and recurse
If s.TimeLine.MainSequence.Count > 0 Then
s.TimeLine.MainSequence.Item(1).Timing.TriggerType = msoAnimTriggerWithPrevious
Dim nextSlide As Slide
Set nextSlide = s.Duplicate.Item(1)
numSlides = 1 + expandAnimationsForSlide(pres, nextSlide)
End If
' Apply visibility
rescan = True
While rescan
rescan = False
For n = 1 To s.Shapes.Count
If s.Shapes.Item(n).Tags.Item(AnimVisibilityTag) = "false" Then
s.Shapes.Item(n).Delete
rescan = True
Exit For
End If
Next n
Wend
' Clear all tags
For Each oShape In s.Shapes
oShape.Tags.Delete AnimVisibilityTag
Next oShape
' Remove animation (since they've been expanded now)
While s.TimeLine.MainSequence.Count > 0
s.TimeLine.MainSequence.Item(1).Delete
Wend
expandAnimationsForSlide = numSlides
End Function
Private Sub assignColor(ByRef varColor As ColorFormat, valueColor As ColorFormat)
If valueColor.Type = msoColorTypeScheme Then
varColor.SchemeColor = valueColor.SchemeColor
Else
varColor.RGB = valueColor.RGB
End If
End Sub
Private Sub PlayAnimationEffect(fx As Effect)
On Error GoTo UnknownEffect
For n = 1 To fx.Behaviors.Count
Dim behavior As AnimationBehavior
Set behavior = fx.Behaviors.Item(n)
Select Case behavior.Type
Case msoAnimTypeSet
' Appear or disappear
If behavior.SetEffect.Property = msoAnimVisibility Then
If behavior.SetEffect.To <> 0 Then
fx.Shape.Tags.Delete AnimVisibilityTag
fx.Shape.Tags.Add AnimVisibilityTag, "true"
Else
fx.Shape.Tags.Delete AnimVisibilityTag
fx.Shape.Tags.Add AnimVisibilityTag, "false"
End If
Else
' Log the problem
End If
Case msoAnimTypeColor
' Change color
If fx.Shape.HasTextFrame Then
Dim range As TextRange
Set range = fx.Shape.TextFrame.TextRange
assignColor range.Paragraphs(fx.Paragraph).Font.Color, behavior.ColorEffect.To
End If
Case Else
' Log the problem
End Select
Next n
Exit Sub
UnknownEffect:
MsgBox ("Encountered an error expanding animations: " + Err.Description)
Exit Sub
End Sub
For those of you using LibreOffice or OpenOffice,
there is a plugin available on github that does this very well :
ExpandAnimations
In my experience, all of the standard appear/disappear animations are nicely split. Object movement animations also work (you get a slide with start position and one with end position of the object). I haven't had the chance to test other animation types, but that should cover about all standard needs :-)
I want to programmatically erase user's pen drawing and annotation over slides in PowerPoint 2003/2007/2010 as an alternative to sending "E" keystroke.
I have found that SlideShowView.EraseDrawing only erases lines made by SlideShowView.DrawLine.
Sample code:
PowerPoint.Application.ActivePresentation.SlideShowSettings.Run.View.EraseDrawing
Thanks for your answers! rjobidon
Are you looking to delete the pen drawing after they've stopped the slide show and chosen to retain the drawing? In that case, invoke the EraseInkOnSlide function below on any slide you want to erase drawings from.
Sub TestMe()
EraseInkOnSlide ActivePresentation.Slides(1)
End Sub
Sub EraseInkOnSlide(oSl As Slide)
' Erases any INK shapes drawn by the user and
' retained when the user quits the slide show
Dim oSh As Shape
Dim x As Long
With oSl.Shapes
For x = .Count To 1 Step -1
If .Item(x).Type = 23 Then
.Item(x).Delete
End If
Next
End With
End Sub
I suspect you'd hve to drop out of slide show mode momentarily then return to the current slide in slideshwo mode in order to get this to work in slide show mode; PPT apparently doesn't consider the ink shapes part of the slide's shapes collection until the user has ended the show and elected to keep the shapes. Weird.
This gives the user the option of keeping or deleting the ink, then goes back to the original slide in slide show view. STILL not what you're after, really, but it's as close as I've been able to get so far:
Private Sub CommandButton1_Click()
Dim x As Long
x = SlideShowWindows(1).View.Slide.SlideIndex
With SlideShowWindows(1)
.View.Exit
End With
With ActivePresentation
.SlideShowSettings.Run
End With
SlideShowWindows(1).View.GotoSlide (x)
End Sub