We prepare hundreds of Powerpoint documents per week for use with screen-reading software and need to remove all animations and transitions from each one. I'd like to write a Powerpoint add-in that automatically does this when the file is loaded. I've figured out how to delete all animations using the following code in an auto_open() sub which I've imported as an add-in:
'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
'Loop through each animation on slide
For x = sld.TimeLine.MainSequence.Count To 1 Step -1
'Remove Each Animation
sld.TimeLine.MainSequence.Item(x).Delete
Next x
Next sld
However, I'm not sure how to delete transitions with this method. I've essentially solved the problem visually by adding in this line,
sld.SlideShowTransition.Duration = 0
but I'd like to outright delete the transitions as they interfere with clients' screen-reading software. Deleting the object in the paradigmatic VBA way (SlideShowTransition.Delete) doesn't work.
Any ideas?
Thanks in advance.
This'll do it:
sld.SlideShowTransition.EntryEffect=0
I want to use several slideshows (in kiosk mode if possible), to be able to jump between them, without going back in edit mode...
No problem to do it with shapes and "hyperlink to a different powerpoint presentation".
But i'd need to do it also in VBA macros, in some slides.
For example, after a quiz is finished, jump to another slideshowwindow and a given slide, and give focus to that slideshowwindow :
What would be the code like ?
I'm unable to give focus to the new slideshowwindow...
I suppose it is the equivalent of what "hyperlink to a different PPT Presentation does, but i can't figure to do it.
Thank you very much in advance !
Alex
This Code opens a Presentation goes to Slide Number 5 and starts in Kiosk Mode
Dim PowerPointApp As PowerPoint.Application
Dim myPPT As PowerPoint.Presentation
'Open the Slideshow
Set myPPT = PowerPointApp.Presentations.Open(FileName:="filename.pptx")
Application.ActivePresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
'You need this to work
ActivePresentation.SlideShowWindow.View.Exit
ActivePresentation.SlideShowSettings.Run
'Goto Slide number 5
myPPT.Windows(1).View.GotoSlide 5
'Start Slide Show
myPPT.SlideShowSettings.Run
I'm trying to reset the contents of some text boxes and labels when I change slides, but I'm struggling to get it to work. I've come up with this after doing a lot of googling and searching, but it doesn't seem to work. I'm trying to use the OnSlideShowPageChange event in PowerPoint 2013 and 2016, but it seems to have no effect. I'm not used to working with PowerPoint vba, so I might be doing something completely wrong.
Edit: I've managed to find an alternative method of resetting the label text. I've managed to get it to reset when the user focuses on one of the text boxes or moves their mouse over the label. But, I'm still curious to know the answer to this question; I'm not sure why my code isn't working.
I'll be greatful if anyone can point out any issues and how to fix them.
Here's what I've got so far:
Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
Dim Sld As Slide
If Wn.View.CurrentShowPosition = 9 Then
'Perform Updates for slide #9
Set Sld = Application.ActivePresentation.Slides(9)
Sld.Shapes(TextBox_Form_Name).TextFrame.TextRange.Text = ""
Sld.Shapes(TextBox_Form_Email).TextFrame.TextRange.Text = ""
Sld.Shapes(TextBox_Form_Message).TextFrame.TextRange.Text = ""
Sld.Shapes(Label_Form_Info).TextFrame.TextRange.Text = ""
End If
If Wn.View.CurrentShowPosition = 18 Then
'Perform Updates for slide #18
Set Sld = Application.ActivePresentation.Slides(18)
Sld.Shapes(TextBox_Form_Name).TextFrame.TextRange.Text = ""
Sld.Shapes(TextBox_Form_Email).TextFrame.TextRange.Text = ""
Sld.Shapes(TextBox_Form_Message).TextFrame.TextRange.Text = ""
Sld.Shapes(Label_Form_Info).TextFrame.TextRange.Text = ""
End If
End Sub
I've also tried putting the shape names in speech marks, but that doesn't seem to help.
By the way, I need the code to work in both PowerPoint 2013 and 2016.
Here's an answer from the PowerPoint FAQ at http://www.pptfaq.com
Suppose your code that depends on the OnSlideShowPageChange( SHW as SlideshowWindow ) event works when run from within VBA or when you launch the presentation from within PowerPoint, but not when you start the show by doubleclicking the icon for the PPS or PPSM. The slide show launches normally, but the code in your OnSlideShowPageChange subroutine never runs.
Solution
Add an Active-X control (from the Developer tab) on first slide (drag it just off the slide if you don't want it visible during the slide show).
This forces VBA to initialize when the presentation starts, so the event gets triggered and your code runs.
The aim is to refresh all charts in Excel after cells recalculation.
I work with Microsoft Excel 2010.
As we know, there is a bug? in Excel so that Excel does not update charts even after
Application.CalculateFullRebuild
A known hack is to do something like this:
Application.ScreenUpdating = False
Temp = ActiveCell.ColumnWidth
ActiveCell.Columns.AutoFit
ActiveCell.ColumnWidth = Temp
Application.ScreenUpdating = True
This does work. However, all Excel charts blink (they become white for a moment while updating). Could you advise, please, is there any way to avoid such blinking?
I tried to call
.Refresh
on all charts (https://msdn.microsoft.com/en-us/library/office/ff198180(v=office.14).aspx):
For Each ChartObject In ActiveSheet.ChartObjects
ChartObject.Refresh
Next
but for some reason my Excel (2010) shows error #438 "Object doesn't support this property or method".
Could you advise, please, do I miss something important?
Untested But the .Refresh may work with this:
Sub ChangeCharts()
Application.ScreenUpdating = False 'This line disable the on screen update for better performance, the blink you see, you could delete both lanes but it will run slower
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.Refresh
Next myChart
Application.ScreenUpdating = True'This line reenable the on screen update for better performance, the blink you see, you could delete both lanes but it will run slower
End Sub
And that's because (as the link you provide shows) .Refresh only works with the object Chart and not with the object ChartObjects as you have been trying to apply it. Hope it'll guide you in the right direction. (also added quotes for the blink/flicker on screen in the code)
Happy Pi Day!
I just did some experiments with animating charts, using VBA to change a counter in a cell, and worksheet formulas to recalculate chart data based on this counter.
I used to do a lot of chart animations, back in the days of Excel 97-2003, and those ran pretty well. When Excel 2007 came out, the animations really degraded, and nothing seemed to help. But just now I did these tesst in the latest build of Office 365 (Version 1904, Build 11504). And it turns out, sometime in the past few years or so, Microsoft has made it work better.
Sub ChartAnimation1()
Dim i As Double
For i = 0 To 1000 Step 50
ActiveSheet.Range("Stepper") = i
Next
End Sub
The animation didn't animate, that is, the chart didn't change despite the data changing.
My experience told me I should put something like DoEvents in the code after I change the cell's value.
Sub ChartAnimation2()
Dim i As Double
For i = 0 To 1000 Step 50
ActiveSheet.Range("Stepper") = i
DoEvents
Next
End Sub
This helped a little, the chart changed, but the animation was not smooth. Some steps were missed, and the effect was a herky-jerky animation.
Sub ChartAnimation3()
Dim i As Double
For i = 0 To 1000 Step 50
ActiveSheet.Range("Stepper") = i
DoEvents
DoEvents
Next
End Sub
This ran a bit more slowly than with one DoEvents, but it was a lot smoother; still not perfect, but pretty good.
More than two DoEvents was overkill: the code took the same length of time, and the animation was not any smoother.
I also tried various combinations of Chart.Refresh, Chart.Activate, and ScreenUpdating. Two takeaways:
Without a couple DoEvents, the animation didn't work regardless of what other things I tried.
With a couple DoEvents, none of these extra steps made the animation any smoother, but they could make it significantly slower.
This was pretty interesting, so I'll blog about it some day. When I do I'll come back and post a link.
As is often the case I was sent to this VBA post following a VB.NET query regarding blinking or flashing Excel Charts after turning on Excel ScreenUpdating. Blinking Charts is something that has been driving me mad for a long time now and I have seen no solutions that work including the above solution that looks like it should work but doesn't. I have now found a solution that works 100% for all of my programs. As this is a VBA post I have shown a VBA solution to the flashing charts but my VB.NET solution is for anyone else who is sent to this post looking for a VB.NET solution. My solution is based on the answer by Zegad above but it has a couple of essential additions that are not documented and which to me are not obvious. Use the following sub as a replacement for "MyXLApp.ScreenUpdating = True". If you find it works for you please do not ask me to explain why it works. I'm sure there are many here who could probably explain this but for me it is the result of luck and dogged determination. An odd addition here is that you actually only need to activate and refresh then deactivate any one chart and all of the charts will update without flashing when re-enabled, See 'VB.NET CODE-2 sub below.
Sub ScrUpdateEnableNoFlicker()'VBA CODE
Dim myChartObj As ChartObject
For Each myChartObj In ActiveSheet.ChartObjects
myChartObj.Activate 'IMPORTANT ADDITION
myChartObj.Chart.Refresh
Next
Cells.Range("A1").Select 'IMPORTANT ADDITION
Application.ScreenUpdating = True
End Sub
Private Sub ScrUpdateEnableNoFlicker() 'VB.NET CODE-1
'BEFORE TURNING SCREEN UPDATING BACK ON...
'ACTIVATE and refresh the chart objects on the sheet with the charts.
Dim aSheet As Excel.Worksheet = CType(mXLWrkbk.Sheets("Sheet1"), Excel.Worksheet)
Dim aChartObjects As Excel.ChartObjects = CType(aSheet.ChartObjects, Excel.ChartObjects)
For Each achartobject As Excel.ChartObject In aChartObjects
achartobject.Activate() 'IMPORTANT - Will not work without activating first
Dim achart As Excel.Chart = achartobject.Chart
achart.Refresh()
Next
'Now deactivate the current activated chart object by selecting any cell
'THIS IS IMPORTANT - It will not work without doing this
Dim selRange As Excel.Range = aSheet.Range("A1")
selRange.Select()
'Now turn Screen Updating back on...
'All of the Charts will have updated and will not flicker
mXLApp.ScreenUpdating = True
End Sub
Private Sub ScrUpdateEnableNoFlicker() 'VB.NET CODE-2
'BEFORE TURNING SCREEN UPDATING BACK ON...
'ACTIVATE ANY ONE of the chart objects on the sheet with the charts.
Dim aSheet As Excel.Worksheet = CType(mXLWrkbk.Sheets("Sheet1"), Excel.Worksheet)
Dim aChartObject As Excel.ChartObject = CType(aSheet.ChartObjects("Chart 9"), Excel.ChartObject)
aChartObject.Activate() 'IMPORTANT - Will not work without activating first
'Refresh just the ONE activated chart.
Dim aChart As Excel.Chart = aChartObject.Chart
aChart.Refresh()
'Now deactivate the current activated chart object by selecting any cell
'THIS IS IMPORTANT - It will not work without doing this
Dim selRange As Excel.Range = aSheet.Range("A1")
selRange.Select()
'Now turn Screen Updating back on...
'You only need to activate/deactivate any one chart and all of the Charts will have updated and will not flicker
mXLApp.ScreenUpdating = True
End Sub
I was having this issue when hiding or showing a series in my chart. The change would not be apparent until I would scroll away then back again to the chart, which was really a pain. I tried all the above solutions with no luck until I realized unselecting and selecting again the chart before doing the change would work.
myChart.TopLeftCell.Select
myChart.Select
...
Good luck in your research for a solution ;)
Thanks to those who have posted here before! Without your successes, I would not have smooth animation of a dynamic simulation. In my case, it is an xlXYScatterLinesNoMarkers type chart. Running in VBA.
This works for me when changing the series programmatically. The chart is animated smoothly. Running Excel 2016 64 bit
Public Sub ShowOneAnimationFrame(worksheetName As String, chartName As String, _
xvals() As Double, yvals() As Double)
'update chart series programmatically
'Excel 2016 64bit
'Dec 21, 2020
'Author: S^3
Dim theChart As chart
Dim chrtObj As ChartObject
Dim oneSeries As Series
Set chrtObj = Sheets(worksheetName).ChartObjects(chartName)
Set theChart = chrtObj.chart
If theChart.SeriesCollection.Count = 0 Then
theChart.SeriesCollection.NewSeries
End If
Set oneSeries = theChart.SeriesCollection(1)
'update the series with new values
oneSeries.XValues = xvals
oneSeries.Values = yvals
theChart.Refresh 'required (this and the next line are required but the order doesn't matter)
chrtObj.Select 'required
Cells.Range("A1") = Cells.Range("A1").value 'something like this is required
End Sub
I have dozens of PowerPoint shows that contain dozens of slides each. They are very basic in that there is only one shape on each slide and there is no animation being used on the shape or between slides. The issue is that the person who created them didn't really pay attention to the vertical position of the shapes from slide to slide so it's very noticeable when going from one slide to the next.
I would like to be able to quickly set the vertical position to the same value for each shape on each slide. The horizontal position is fine. I've been doing them manually but there are a lot of slides and slide shows to go through and I'd rather not have to do this as it is very time consuming.
I've done some searching here on this site as well as on Google but haven't found anything yet. If it requires VBA code, that's fine too.
I am using PowerPoint 2010.
As a starting point (total air code, mind you):
Sub LineEmUpDano()
Dim oSl as Slide
Dim sngTop as Single
' Pick up the top position of the first shape
' on the first slide:
SngTop = ActivePresentation.Slides(1).Shapes(1).Top
' Apply the top position to each slide in the pres
For Each oSl in ActivePresentation.Slides
oSl.Shapes(1).Top = sngTop
' you could instead use
' oSl.Shapes(1).Top = 42 ' or whatever value you like
' Values are in points, 72 points to the inch
Next ' slide
End Sub
Using Steve's suggestion above as a jumping off point and then reading some tutorials I was able to come up with a working script:
Sub UniformHeight()
Dim SlideToCheck As Slide
Dim ShapeIndex As Integer
For Each SlideToCheck In ActivePresentation.Slides
For ShapeIndex = SlideToCheck.Shapes.Count To 1 Step -1
SlideToCheck.Shapes(ShapeIndex).Top = 36
Next
Next
End Sub