Moving video on every slide in powerpoint - vba

I'm just poking around in VBA with PowerPoint and know that what I want to do can be done. I just don't know the write calls/sytanx to use!
I want a macro that will run through all the slides in a presentation and move the video object to specific spot on the slide. The spot will be the same on all slides.
It would be very helpful if someone could show me how to do this! Or at least point me in the right direction. Thanks!
Here's what I found for doing something on every slide
Sub EveryTextBoxOnSlide()
' Performs some operation on every shape that contains text on every slide
' (doesn't affect charts, tables, etc)
Dim oSh As Shape
Dim oSl As Slide
On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
' If font size is mixed, don't touch the font size
If .TextFrame.TextRange.Font.Size > 0 Then
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size + 2
End If
End If
End If
End With
Next ' shape
Next ' slide
NormalExit:
Exit Sub
ErrorHandler:
Resume Next
End Sub
And this is something I found to move the object to desired location (here's where I don't know what to call the video object)
With ActiveWindow.Selection.ShapeRange
.Left = 640 'change the number for desired x position
.Top = 75 'change the number for desired y position
End With
End Sub
Sub ll()
End Sub
So basically, I want to run the last piece as a function of the first one instead of shapes with text. Does that make sense?
I've done some programming in the past, mainly with actionscript and Flash. I could probably write out some basic functions, just not sure how to run it in VBA without learning a whole new language. Which I don't want to do, since I'm an instructional designer and don't have the free time to learn it! :)

Here's a little function that'll return True if the shape you pass to it is a video, and a bit of example code to test it with:
Function IsVideo(oSh As Shape) As Boolean
If oSh.Type = msoMedia Then
If oSh.MediaType = ppMediaTypeMovie Then
IsVideo = True
Exit Function
End If
End If
' Things get a little trickier if the movie is in a placeholder
' Is it a placeholder? and is it a media object?
If oSh.Type = msoPlaceholder Then
If oSh.PlaceholderFormat.ContainedType = msoMedia Then
' it's a media object, but we don't know if it's
' a movie or sound or what, so we duplicate it
' then look at the duplicate (which is now a copy
' of the placeholder content but is not a placeholder itself)
With oSh.Duplicate
If .Type = msoMedia Then
If .MediaType = ppMediaTypeMovie Then
IsVideo = True
End If
End If
' and delete the duplicate
.Delete
End With
End If
End If
End Function
Sub thing()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If IsVideo(oSh) Then
oSh.Left = 0
End If
Next
Next
End Sub

Now you're getting somewhere!
I don't know what kind of shape holds your video, so this modification should help you identify it.
Sub EveryTextBoxOnSlide()
Dim oSh As Shape
Dim oSl As Slide
On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
.Select
End With
Next
Next
NormalExit:
Exit Sub
ErrorHandler:
Resume Next
End Sub
While there is no need whatsoever to use the .Select in your final code, this is only here to help you identify which shape actually holds the video. Put a breakpoint (F9) on that line and run your code (F5), then debug through it with F8 to execute one line at a time and run through your loop looking at each shape until you see that your video has been selected.
Once your video has been selected look at the various properties (using the Immediate Window of the IDE) of oSh until you find the uniqueness that identifies this is your video. (There may be some property about the content type of the shape, or a link on where to find the contents that contains the text string ".avi", ".mpg", ".flv", etc - there will be some sort of identifier you can find.)
Once you've identified what makes the shape the holder of a video, replace
.Select
with
If {my video containing shape criteria is true} Then
With .Selection.ShapeRange
.Left = 640 'change the number for desired x position
.Top = 75 'change the number for desired y position
End With
End If
Changing the values (as commented) to whatever it is that you need.
Important Note: It is very good that your sample code has some error handling built in, but all this error handler is doing is sweeping any errors under the rug. This particular handler is the very long form version of On Error Resume Next which does have its uses, but in very, very limited situations.
As you get your code working, you'll actually want to put something useful in the ErrorHandler: section, but that's the topic for a whole new question.

Ok, here is how I modified the code supplied above to do this in my case:
Sub EveryTextBoxOnSlide() ' Performs some operation on every shape that contains text on every slide ' (doesn't affect charts, tables, etc) Dim oSh As Shape Dim oSl As Slide On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
If .Type = msoMedia Then
If .MediaType = ppMediaTypeMovie Then
.PictureFormat.Crop.PictureHeight = 236
.PictureFormat.Crop.PictureWidth = 314.2115
.PictureFormat.Crop.PictureOffsetX = 8.737323
.PictureFormat.Crop.PictureOffsetY = 0
.PictureFormat.Crop.ShapeHeight = 236.3478
.PictureFormat.Crop.ShapeWidth = 163
.PictureFormat.Crop.ShapeLeft = 796.6956
.PictureFormat.Crop.ShapeTop = 0
End If
End If
End With
Next ' shape Next ' slide
NormalExit: Exit Sub
ErrorHandler: Resume Next
End Sub

Related

Can a Macro Uncomment itself?

Suppose I have the below, in which for every selected shape another one will be created:
For Each Shp In ActiveWindow.Selection.ShapeRange'.GroupItems
as you can see, at the end of the line objects within groups are commented out. Would it be possible to tell VBA to uncomment it, if for example a ListBox gives the option to apply the macro for grouped items? This would not be out of laziness, rather to save lines and possibly reduce the file size. And just to understand more how everything works. Or VBA is intrinsically blind to comments?
Here's a simple example of handling shapes whether within groups or not:
Sub Main()
Dim oSh As Shape
For Each oSh In ActivePresentation.Slides(1).Shapes
Call HandleShape(oSh)
Next
End Sub
Sub HandleShape(oSh As Shape)
Dim x As Long
If oSh.Type = msoGroup Then
For x = 1 To oSh.GroupItems.Count
Call HandleShape(oSh.GroupItems(x))
Next
Else
oSh.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
End Sub

Powerpoint Macro VBA - Select checkbox for "Slide Image"

I have been trying to modify a useful piece of code created by David Foster some time ago,
However the one really useful addition to this code is proving hard to find in the references.
I need to get the macro to make sure that the "Slide Image" checkbox is ticked when it applies the notes master to all slides, as some slides have been "frankensteined" into the project.
I am struggling to find any reference to this checkbox in powerpoint references, any ideas?
Sub DReplaceNotesMaster()
' Modified version of code originally posted to
' msnews.microsoft.com public newsgroups by
' David Foster in May of 1999
Dim ctl As CommandBarControl
Dim oSl As Slide
' 700 is the control ID for Layout
Set ctl = CommandBars.FindControl(Id:=700)
ActiveWindow.ViewType = ppViewNotesPage
If (ctl Is Nothing) Then
MsgBox "command not available"
Exit Sub
End If
For Each oSl In ActivePresentation.Slides
' go to the current slide
ActiveWindow.View.GotoSlide (oSl.SlideIndex)
DoEvents
' Bring up the dialog
ctl.Execute
DoEvents
' send it the needed keystrokes
SendKeys "%r{enter}"
DoEvents
Next
End Sub
Oddly, the slide image on a notes page is referred to as a title placeholder. This sub checks every notes page for a placeholder with "Slide Image" in the name and adds it if one is not found. This assumes that someone hasn't used the Selection pane to rename the slide image placeholder. If they have, you'll have to trap the resulting error that displays a message "Invalid request: Slide already contains maximum placeholders of this type".
Sub ShowNotesSlideImage()
Dim oSlide As Slide
Dim oShape As Shape
Dim bTitleFound As Boolean
For Each oSlide In ActivePresentation.Slides
bTitleFound = False
For Each oShape In oSlide.NotesPage.Shapes
If oShape.Type = msoPlaceholder Then
If InStr(oShape.Name, "Slide Image") > 0 Then
bTitleFound = True
End If
End If
Next oShape
If bTitleFound = False Then
oSlide.NotesPage.Shapes.AddPlaceholder Type:=ppPlaceholderTitle
End If
Next oSlide
End Sub
A handy resource for finding control names and ID numbers is Microsoft's Office 2016 Help Files: Office Fluent User Interface Control Identifiers, a free download.

How to check if all TextBoxes in a PowerPoint document are filled in

I have a PowerPoint document where users can input text into several TextBoxes, over 6 slides in total.
On the last slide, I want to check if the user has filled in every TextBox in the presentation.
I tried using lots of code snippets on the internet and modifying them, however I am a complete VBA noob and, surprisingly, it did not work out. :')
I would greatly appreciate your help with this task.
It would be even better if it is possible to check whether the user has input AT LEAST 4 characters in each textbox. However I have no idea how to start programming this...
Here is my code, it does not show errors however nothing happens when clicking the CheckBox at the end.
Public Sub CheckTextBox()
Dim fTextBox As Object
For Each Slide In ActivePresentation.Slides
For Each fTextBox In ActivePresentation.Slides
If TypeName(fTextBox) = "TextBox" Then
If fTextBox.Text = "" Then
MsgBox "Please make sure to fill out all fields!"
End If
End If
Next
Next
End Sub
'When ticking this CheckBox, the MsgBox should show up
Private Sub CheckBox1_Click()
CheckTextBox
End Sub
Thank you guys so much for your help.
Your inner For-loop is wrong, you need to loop over all Shapes of the slide, instead, you start another loop over all slides.
Basically, all objects that you place on a slide are Shapes. If you use TypeName, you will get Shape. To distinguish the single shape-types, use the property type of the shape-object. A list of types can be found at https://learn.microsoft.com/de-de/office/vba/api/office.msoshapetype - a textbox has a type msoTextBox (17).
To get the text of a shape, use the property TextFrame.TextRange.Text of the shape.
Try the following code (it checks already for a length of at least 4 characters). It will stop at the first textbox that has less than 4 chars in it (else, you would get one MsgBox for every textbox) and select it.
Public Sub CheckTextBox()
Dim sh As Shape, slide As slide
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Debug.Print TypeName(sh)
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < 4 Then
MsgBox "Please make sure to fill out all fields!"
slide.Select
sh.Select
Exit For
End If
End If
Next
Next
End Sub
UPDATE
The code above didn't take into account the shapes within groups. The following code loops over all shapes of all slides and calls the function checkShape that will check
a) If the shape is a textBox (msoTextBox, 17) - if yes, the length of the text is checked and if too short, that shape is returned.
b) If the shape is a group (msoGroup, 6), it calls (recursively) the function for all child shapes and returns the first child textbox found.
The main routine (CheckAllTextBoxes) checks if any textBox was found, and, if yes, will select it and issue the message.
Public Sub CheckAllTextBoxes()
Dim slide As slide, sh As Shape
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Dim textBox As Shape
Set textBox = CheckShape(sh, 4)
If Not textBox Is Nothing Then
slide.Select
textBox.Select
MsgBox "Please make sure to fill out all fields!"
Exit Sub
End If
Next
Next
End Sub
Function CheckShape(sh As Shape, minLen As Integer) As Shape
' Check if shape is a Textbox and then text is not long enough
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < minLen Then
Set CheckShape = sh
Exit Function
End If
End If
' For a group, check all it's child shapes
If sh.Type = msoGroup Then
Dim child As Shape
For Each child In sh.GroupItems
Dim textBox As Shape
Set textBox = CheckShape(child, minLen)
If Not textBox Is Nothing Then
' Found a Textbox within the group, return it
Set CheckShape = textBox
Exit Function
End If
Next child
End If
End Function
For those looking for c# code to list all text boxes in a presentation:
using Microsoft.Office.Interop.PowerPoint;
using MsoShapeType = Microsoft.Office.Core.MsoShapeType;
public static IEnumerable<Shape> AllTextBoxes (Presentation presentation) =>
from slide in presentation.Slides.Cast<Slide>()
from shape in slide.Shapes.Cast<Shape>()
from textBox in AllTextBoxes(shape)
select textBox;
public static IEnumerable<Shape> AllTextBoxes (Shape sh)
{
IEnumerable<Shape> _() { if (sh.Type == MsoShapeType.msoTextBox) yield return sh; }
return sh.Type == MsoShapeType.msoGroup ? sh.GroupItems.Cast<Shape>().SelectMany(AllTextBoxes) : _();
}

How do I grab the section title and change the title of the slides in the section?

I'm writing a script in VBA to change the Title's of the slide to the section title. I have multiple sections and I want to iterate though the ppt to change all the titles of the slides to have the same section title as its section.
I've tried finding how to grab the section title and set it to the slide's title.
Sub test()
ActivePresentation.Slides.Name = ActivePresentation.SectionProperties(sectionName)
End Sub
I need to add iteration, I need i believe syntax is messed.
Hopefully something like the following is what you're looking for. The code
Loops through each slide in the ActivePresentation, adding a title if there isn't already one.
Changes the title text by getting the sectionIndex property of the slide, and then using that index in the SectionProperties.Name method to retrieve the corresponding text.
Sub ChangeMyTitles()
Dim sld As Slide
Dim titleShape As Shape
If ActivePresentation.SectionProperties.Count = 0 Then Exit Sub
For Each sld In ActivePresentation.Slides
With sld
If Not .Shapes.HasTitle Then
Set titleShape = .Shapes.AddTitle
Else
Set titleShape = .Shapes.Title
End If
titleShape.TextFrame2.TextRange.Text = ActivePresentation.SectionProperties.Name(.sectionIndex)
End With
Next sld
End Sub
EDIT:
If you want to modify a different placeholder than the title, you could do something like this. Based on your screenshot, I assume that the placeholder you want to modify is the 3rd one (title is 1st, body is 2nd, and chapter is 3rd), but you might have to change the 3 below.
Sub ChangeMyChapters()
Dim sld As Slide
Dim chapterShape As Shape
If ActivePresentation.SectionProperties.Count = 0 Then Exit Sub
For Each sld In ActivePresentation.Slides
With sld
Set chapterShape = .Shapes.Placeholders(3)
chapterShape.TextFrame2.TextRange.Text = ActivePresentation.SectionProperties.Name(.sectionIndex)
End With
Next sld
End Sub

Run macro and hyperlink in one mouse click

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)