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.
Related
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 want to create a macro to set the font for all textboxes throughout PowerPoint.
I have the code to set them but for error handling I need to make sure that the font entered by the user is valid and therefore I need the full collection of fonts that PowerPoint has installed.
Private Sub ChangeTextFont_Click()
Dim oSl As Slide
Dim oSh As Shape
Dim strFontName As String
Dim ValidFont As Font
strFontName = InputBox("Enter the name of the font to use for the text on the screens or press Cancel to keep the existing font.", "Enter Font Name")
If Trim(strFontName) = "" Then Exit Sub
'For Each ValidFont In <collection of all fonts powerpoint has> <-------- this is my issue
If strFontName = ValidFont Then
With ActivePresentation
For Each oSl In .Slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
If oSl.Name <> "Config" Then
.TextFrame.TextRange.Font.Name = strFontName
End If
End If
End If
End With
Next
Next
End With
End If
'Next
End Sub
Ideally, I need the solution to only use PowerPoint (not launching Word as this has different font selection) and not be too long as this isn't supposed to be a difficult problem.
So in the end this was easiest to do pulling the list from word. I thought the list was different but that was due to caching fonts in the document I was comparing. Anyway for a good solution please check out the answer on this question: Get a list of all fonts in VBA Excel 2010
You could try looking in the Microsoft Office\root\Office16\1033\PUBFTSCM\FONTSCHM.INI file in your install directory and then parse through that...
Not sure what kind of data in there would be helpful, but it's a start.
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
In the Powerpoint VBA editor, we get a list of slides in the VBA project window, categorised under "Microsoft PowerPoint Objects". This list will include slides that have ActiveX controls on them.
The slides appear with numbers on them ("Slide1", "Slide3", etc), and these numbers look like they are based on the order in which the slides were added to the presentation - not the actual order of the slides in the current presentation. However, the title or name of the slides is not included. This makes it confusing to work with, and difficult to find the slide that has the control one wants to work with.
In Excel VBA, the layout of the editor is the same, with a list of worksheets. However, in Excel the name of the sheet is shown in brackets after the sheet number. So if Sheet1 is called "MyDataSheet", it will show up as "Sheet1 (MyDataSheet)".
How can I achieve something similar in Powerpoint? Is there are way to control the name/title that is used to display each slide in the Powerpoint editor?
This is one of the oddities of the PPT object model. Each slide has an internal name that's assigned by PPT at the time the slide is created. That's what you see in the IDE. Each slide also has a .Name property that's initially the same as the slide name assigned by PPT, but that you can change programmatically.
PPT still shows the assigned name under "Microsoft PowerPoint Objects" but if you look at the Properties window of the IDE (press F4 to display it) you'll see (and can edit) the slide's .Name property. This would let you know which slide you've selected in the IDE.
You could also run a bit of code to change the .Name property in a way that reflect's the slide order:
Sub Thing()
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
oSl.Name = "SLIDE_" & CStr(oSl.SlideIndex)
Next
End Sub
If you want to get a bit fancier, you can have it pick up the slide's title (if any) as the .Name and use SLIDE_index as the .Name if not:
Sub Thing()
Dim oSl As Slide
Dim sTemp As String
For Each oSl In ActivePresentation.Slides
sTemp = SlideTitle(oSl)
If Len(sTemp) > 0 Then
oSl.Name = oSl.Shapes.Title.TextFrame.TextRange.Text
Else
oSl.Name = "SLIDE_" & CStr(oSl.SlideIndex)
End If
Next
End Sub
Function SlideTitle(oSl As Slide) As String
On Error GoTo ErrHandler
SlideTitle = oSl.Shapes.Title.TextFrame.TextRange.Text
NormalExit:
Exit Function
ErrHandler:
SlideTitle = ""
GoTo NormalExit
End Function
One thing to be careful of here is that PPT may or may not complain if you try to give two slides the same .Name property. In other words, you may want to make sure that your slide titles are unique. There might be other issues (characters that aren't allowed in .Name for example).
I am trying to select a slide by name. I have added a title via the outline. below is the code that is not working. "item Idaho not found in the slide collection"
ActivePresentation.Slides("Idaho").Select
The slide's name and the text in the title placeholder nave nothing to do with one another.
Unless you've renamed it, the first slide in the presentation will be named "Slide1", the second "Slide2" and so on.
If you specifically need a way to locate the slide whose title text = "Idaho", you'd need to write a function to search all the slides in the presentation and return the first one it finds that meets your criteria. For example:
Sub TestMe()
Dim oSl As Slide
Set oSl = FindSlideByTitle("idaho")
If Not oSl Is Nothing Then
MsgBox "Found your title on slide " & CStr(oSl.SlideIndex)
End If
End Sub
Function FindSlideByTitle(sTextToFind As String) As Slide
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
With oSl.Shapes.Title.TextFrame
If .HasText Then
If UCase(.TextRange.Text) = UCase(sTextToFind) Then
Set FindSlideByTitle = oSl
End If
End If
End With
Next
End Function
Reviving an old question, but I wanted to throw this in.
While it's possible that ActivePresentation.Slides("MySlideName").Select doesn't work, this does work for me in PPT 2010:
Dim PPTObj As PowerPoint.Application
Set PPTObj = New PowerPoint.Application
Dim PPTClinic As PowerPoint.Presentation
Set PPTClinic = PPTObj.Presentations.Open(FileName:="Your File Name Here")
PPTClinic.Slides("MySlideName").Select
This, of course, assumes that there is a slide named "MySlideName". Your code will have to deal with gracefully handling the Item MySlideName not found in the Slides collection. error (err.number = -2147188160).