Powerpoint global button - vba

I think it's a simple question for anybody with some VBA skills oder PowerPoint-pro's:
I have a presentation like a quiz, and I like to offer three jokers like in WWTBAM.
So I created three buttons and i made the 50:50 button, that on click an animation starts so, that to wrong answers are hidden. So I now just want to, that if you clicked the joker-button on one slide, it have to be removed / disabled / crossed on ALL other following slides.
Is there anybody who can show me a simple snippet which will do that?
That would be really great.
Thanks!

This should get you going in the right direction:
Option Explicit
' The name of the shape(s) to search for
' (name shapes in the Selection Pane : Alt+F10 for PowerPoint 2010 and later)
Public Const ShapeName = "50/50"
' Purpose: Macro to HIDE all shapes on all slides that match the specified name
' Usage: Assign to any shape(s) on a slide via the Insert Tab / Action / Mouse Click / Run Macro
' Author: Jamie Garroch of YOUpresent Ltd. (http://youpresent.co.uk/)
Public Sub HideAll()
Dim oSld As Slide
Dim oShp As Shape
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.Name = ShapeName Then oShp.Visible = msoFalse
Next
Next
End Sub
' Purpose: Macro to SHOW all shapes on all slides that match the specified name
' Usage: Assign to any shape(s) on a slide via the Insert Tab / Action / Mouse Click / Run Macro
' Author: Jamie Garroch of YOUpresent Ltd. (http://youpresent.co.uk/)
Public Sub ShowAll()
Dim oSld As Slide
Dim oShp As Shape
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.Name = ShapeName Then oShp.Visible = msoTrue
Next
Next
End Sub

Related

VBA PowerPoint: Insert custom slide layout into current position not the end of the slide pack

ISSUE
I know one can insert a PPT layout with one of the standard PpSlideLayout constants (ie: ppLayoutBlank) into current position however I cannot figure out to do the same with custom slide layout. (ie as below with 01 Divider slide numbered)
HELP
CODE BELOW
Inserts the custom slide layout named 01 Divider slide numbered to the end of the powerpoint presenatation.
'Insert Divider page layout
Sub Add01DividerSlideNumbered()
Dim oSlides As Slides, oSlide As Slide
Set oSlides = ActivePresentation.Slides
Set oSlide = oSlides.AddSlide(oSlides.Count + 1, GetLayout("01 Divider slide numbered"))
End Sub
'Callback for customButton onAction
Sub Adds01DividerSlideNumbered(control As IRibbonControl)
Call Module1.Add01DividerSlideNumbered
End Sub
You can get the current slide index as follows...
ActivePresentation.Windows(1).View.Slide.SlideIndex

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.

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)

VBA PowerPoint Display and Hide Shapes

I have several PowerPoint slides with objects (arrows and rectangles) I like to display and hide. At the moment I just use
ActivePresentation.Slides("Slide100").Shapes("Rectangle 99").Visible = False or True
ActivePresentation.Slides("Slide100").Shapes("Straight Arrow Connector 118").Visible = False or True
Now it can be that one rectangle or arrow has to be deleted in that template. This leads to VBA errors when you run the macro because the rectangle or arrow couldn't be found. Is there any way to write a macro to check all the used rectangles and arrows and then hides or displays them all instead of using single variables?
I found something like this:
For Each sObject In ActivePresentation.Slides(2).Shapes
sObject.Visible = False
Next
But I just need to hide rectangles and arrows, nothing more.
Best regards
Peter
Take that loop as a starting point and apply some logic within it. There are two properties of the shape that could be useful, autoshapetype and name
Two examples below:
For Each shp In ActivePresentation.Slides(x).Shapes
If InStr(1, shp.Name, "Rectangle") > 0 Then
shp.Visible = False
End If
Next shp
or
For Each shp In ActivePresentation.Slides(x).Shapes
If shp.AutoShapeType = msoShapeRectangle Then
shp.Visible = False
End If
Next shp
This will hide all rectangle types and a subset of arrow types across all slides in the active presentation:
' PowerPoint VBA Macro
' Purpose : hide rectangles and shapes across slides
' Written by : Jamie Garroch of YOUpresent Ltd. http://youpresent.co.uk.
Sub HideRectanglesAndArrows()
Dim oSld As Slide
Dim oShp As Shape
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.Type = msoAutoShape Then
Select Case oShp.AutoShapeType
' Basic Arrows (4)
Case msoShapeUpArrow, msoShapeDownArrow, msoShapeLeftArrow, msoShapeRightArrow
oShp.Visible = msoFalse
' Double Arrows (2)
Case msoShapeUpDownArrow, msoShapeLeftRightArrow
oShp.Visible = msoFalse
' Add other arrow types as required
'
' Basic Rectangles (1)
Case msoShapeRectangle
oShp.Visible = msoFalse
' Rounded Rectangles (4)
Case msoShapeRound1Rectangle, msoShapeRound2DiagRectangle, msoShapeRound2SameRectangle, msoShapeRoundedRectangle
oShp.Visible = msoFalse
' Snipped Rectangles (4)
Case msoShapeSnip1Rectangle, msoShapeSnip2DiagRectangle, msoShapeSnip2SameRectangle, msoShapeSnipRoundRectangle
oShp.Visible = msoFalse
End Select
End If
Next
Next
End Sub
You can then add logic to delete specific shapes using the .Name property or position properties (.Left, .Top) or size properties (.Width, .Height). If you want o be more elaborate (users can change the names of shapes) then you could add Tags to shapes to identify them in a way that the user cannot change and then write a procedure to check the .Tags property in your logic.

Remove shadow effect from text in powerpoint 2010 VBA

I am trying to remove all the shadow effects from all the textframes in the any slides of the presentation via a macro .
The below macro is running well with powerpoint 2007 but not working with 2010.
Sub NoTextShadows()
Dim oSld As Slide
Dim oShp As Shape
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Font.Shadow = msoFalse
oShp.Shadow.Visible = msoFalse
End If
End If
Next oShp
Next oSld
End Sub
Please suggest any idea to workaround this. Thanks.
I made some tests and I found out that shadows in PowerPoint 2010 can appear for Text (for specific) and for shapes in general. It's strange that two shadows can be applied to the shape independently, but only one of them could be removed by Macro. Here is what I did to remove one layer of shadow :
oShp.Shadow.Size = 0
OShp.Shadow.Blur = 0
oShp.Shadow.Visible = msoFalse
Try adding these lines inside your main For Loop and see
For more information, Working with Properties of the ShadowFormat Class in Office 2010