My Office 365 PowerPoint presentation has a single slide. The slide includes a shape with embedded (not linked, not OLE) video which I originally inserted from an .mp4 file. The video starts playing when I click on it but I need to control it from VBA code. Nothing I've tried (see below) works and of course I get no error messages or any kind of feedback. How do I start (and stop) the video from code?
Sub PlayVideo(Name)
Set Shape = GetShape(Name)
' Shape.MediaType == ppMediaTypeMovie
With Shape.AnimationSettings
.Animate = msoTrue
.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 0
.TextLevelEffect = ppAnimateByAllLevels
With .PlaySettings
.PlayOnEntry = msoTrue
.PauseAnimation = msoFalse
.LoopUntilStopped = msoTrue
End With
End With
With Slide.TimeLine.MainSequence
Set AnimationEffect = .AddEffect(Shape:=Shape, effectid:=msoAnimEffectMediaPlay)
With AnimationEffect
Set Behaviour = .Behaviors.Add(msoAnimTypeCommand)
With Behaviour
.CommandEffect.Type = msoAnimCommandTypeVerb
.CommandEffect.Command = "play"
End With
End With
End With
End Sub
To start the video use
SlideShowWindows(1).View.Player("algorithm panel").Play
To stop the video use
SlideShowWindows(1).View.Player("algorithm panel").Stop
Here is an example. Paste this in a module. My video name is SAMPLE.mp4
Option Explicit
Sub StartVideo()
SlideShowWindows(1).View.Player("SAMPLE").Play
End Sub
Sub StopVideo()
SlideShowWindows(1).View.Player("SAMPLE").Stop
End Sub
Next insert 2 action button in the slide and assign the macros
And we are done.
Related
When Word 2010 starts I would to automatically execute the VBA code
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
to make the document fit the page.
Many thanks for a tip
You can put your command(s) in the AutoExec macro.
Sub AutoExec()
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
End Sub
You could add a macro like the following to the 'ThisDocument' code module of a global template (e.g. Normal.dotm):
Private Sub Document_Open()
With ActiveWindow
'Reduce flickering while changing settings
.Visible = False
'Switch to a single view pane
.View.SplitSpecial = wdPaneNone
.View.Type = wdPrintView
.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
'Restore the window now that we're finished
.Visible = True
End With
End Sub
I have developed a Powerpoint VBA function to which I pass a Shape and Slide object.
The function finds for a shape with text LOGO inside it, if it finds, it replaces that shape with the shape I passed to the function.
Function works perfectly on office 2013 but not on Office 2016.
Can anybody please suggest a work around for this?
Public Sub AddLogo_ONE(shLogo As Shape, oSlide As PowerPoint.Slide)
Dim sh As Shape
For Each sh In oSlide.Shapes
If sh.HasTextFrame Then
If UCase(sh.TextFrame2.TextRange.Text) = "LOGO" Then
oSlide.Select
DoEvents: DoEvents
shLogo.Copy
With oSlide.Shapes.Paste
.LockAspectRatio = msoFalse
.Left = sh.Left
.Top = sh.Top - ((.Height - sh.Height) / 2)
.AlternativeText = "LogoMacro"
sh.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Exit For
End If
End If
Next
End Sub
Below is the error message I get on Powerpoint 2016:
That's the dreaded machine dependent timing issue with VBA/Clipboard/WinOS. I have personally spent hours trying to devise a clever solution for this, even using WinAPIs to check and wait for a PowerPoint type of content to be available in the clipboard before proceeding with a Paste operation, all to no avail.
The only solution I have found that works is to slow VBA down with a delay. Nasty workaround as it's still machine dependent. This is the function I use:
Public Sub Delay(Seconds As Single, Optional DoAppEvents As Boolean)
Dim TimeNow As Long
TimeNow = Timer
Do While Timer < TimeNow + Seconds
If DoAppEvents = True Then DoEvents
Loop
End Sub
If you call this as follows (reduce the time from 1 second until it fails and then double it again!), it should solve your issue:
shLogo.Copy
Delay 1, True
With oSlide.Shapes.Paste
I have a PowerPoint Presentation with embedded word document. I have a macro button on the presentation which opens the embedded word document, changes some stuff in in, and saves it (word) as PDF document. But as soon as everything is done, the user is shown the powerpoint slides mode while presentation(slideshow) is still running in background. How can I bring the focus back to the running slideshow? The macro is supposed to run in slideshow mode.
Below is my code
Private Sub Gen_Click()
' I am changing the presentation to normal view, in order to execute DoVerb thing!
ActivePresentation.Windows(1).Activate
With ActivePresentation.Slides(2).Shapes(1)
If .Type = msoEmbeddedOLEObject Then
For Each sVerb In .OLEFormat.ObjectVerbs
nCount = nCount + 1
If sVerb = "Open" Then
.OLEFormat.DoVerb nCount
Exit For
End If
Next
End If
End With
'switch back to slide show view
SlideShowWindows(1).Activate
'getting opened word document object to do stuff in in
Set objWord = GetObject(, "Word.Application")
Set objDoc = objWord.ActiveDocument
objWord.Visible = False
'Doing stuff here
'closing the word doc
objDoc.Saved = True
objWord.Quit
End Sub
This code is making power point to return to normal mode with button to Resume slideshow!
Finally got it working using CommandBar controls to switchback to the slideshow mode!
added following code before End Sub
Call CommandBars.FindControl(Id:=740).Execute
If Err.Number <> 0 Then
MsgBox strErrorMessage
Err.Clear
End If
740 is the id for running slideshow from the ribbon menu!
Maybe this works as well and is even simpler:
' change focus to power point
AppActivate (ActivePresentation.Name)
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 :-)
(disclaimer: i'm not a VBA programmer by occupation)
Attached to buttons in the Ribbon I have code to toggle the company logo in a Word Document.
One button for the logo type A, a second button for logo type B and a third for no logo (logo is preprintend on paper)
First I remove the logo with removeLogo and then i add it the requested logo with setLogoAt.
The first button click is fine (e.g. for Logo Type A), a logo is added to the header of the document. When i click an other button (e.g for Logo Type B) Word crashes (probably on removing the current logo)
What is wrong with my code (or less probably: with Word?)
Sub setLogoAt(left As Integer, path As String)
Dim logoShape As Shape
Dim anchorLocation As Range
Dim headerShapes As Shapes
Set logoShape = ActiveDocument. 'linebreks for readability
.Sections(1)
.Headers(wdHeaderFooterPrimary)
.Shapes
.AddPicture(FileName:=path, LinkToFile:=False,
SaveWithDocument:=True, left:=0,
Top:=0, Width:=100, Height:=80)
logoShape.name = "CompanyLogo"
logoShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
logoShape.RelativeVerticalPosition = wdRelativeVerticalPositionPage
logoShape.Top = CentimetersToPoints(0.1)
logoShape.left = CentimetersToPoints(left)
End Sub
Sub removeLogo()
Dim headerShapes As Shapes
Set headerShapes = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
Dim shapeToDelete As Shape
If (headerShapes.Count > 0) Then
If Not IsNull(headerShapes("CompanyLogo")) Then
Set shapeToDelete = headerShapes("CompanyLogo")
End If
End If
If Not (shapeToDelete Is Nothing) Then
shapeToDelete.Delete
End If
End Sub
edit
I steped trough my code. All is fine until I reach the line shapteToDelete.Delete in removeLogo. Here Word crashes hard, even while debugging. I'm using Word 2007 (and that is a requirement)
edit2
I cleared all macros, all normals.dot, all autoloading templates, then created a new document with the two routines above and this test method:
Sub test()
setLogoAt 5, "C:\path\to\logo.jpg"
removeLogo
setLogoAt 6, "C:\path\to\logo.jpg"
End Sub
When I run test it crashes in removeLogo at shapeToDelete.Delete.
Edit 3
I 'solved' the problem by first making the headers/footers view the active view in Word, then deleting the Shape and then returning to normal view. Very strange. It works but as a programmer I'm not happy.
Another potential solution is to try and select the shape first and then delete the selection:
shapeToDelete.Select
Selection.Delete
You would probably want to switch off screen updating if this works, else you'll get flickering as Word moves around the document.
I've experienced this problem before and normally with an automation error: "The object invoked has disconnected from its clients". I haven't yet found a solution.
However a good workaround is to hide the shape rather than delete it.
So:
shapeToDelete.Visible = False
This works:
I only have 2 boxes to hide so this isn't generic
Private Sub btnPrint_Click()
Dim hdrShapes As Shapes
Dim S As Shape
Dim aTohide(2) As String
Dim iNdx, i As Integer
iNdx = 0
' Hide buttons and print
Set hdrShapes = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
' GET BUTTON NAMES (ACTUALLY TEXT BOXES
For Each S In hdrShapes
If S.Type = msoTextBox Then
aTohide(iNdx) = S.Name
iNdx = iNdx + 1
End If
Next
' now hide , use the arrays as the for each statement crashes
For i = 0 To 1
hdrShapes(aTohide(i)).Visible = msoFalse
Next
' print it
With ActiveDocument
.PrintOut
End With
' and unhide the buttons
For i = 0 To 1
hdrShapes(aTohide(i)).Visible = msoTrue
Next
Set hdrShapes = Nothing
End Sub