Header
PowerPoint tips, hints and tutorials that will change your presentations for ever!

INDEX

 

Jigsaws
Sounds
Video
Custom Shows
vba code
NaviSlides
Games for teachers
Bullets
Triggers
Security
Flash Cards
Multiple Instances
PowerPoint 2007
Mail Merge
Random events
Animation
Hyperlinks
Set spellcheck language


Home buttonTutorial buttonContact buttonProducts button


Some vba Samples

If you haven't already read How to Use vba Code you should do this first.


Last Slide Viewed + 1

This code snippet is for use in Slide show mode ONLY. Copy and paste it to a module see How to use vba Code and then give an action button an action of Run > Macro > lastplus

Sub lastplus()
On Error Resume Next
With SlideShowWindows(1).View
.GotoSlide (.LastSlideViewed.SlideIndex + 1)
End With
End Sub

The action button you make will return you to the slide AFTER the last slide viewed. Note that the on error statement is used because in the case of an error (no slide +1) it ignores it. You can change the code to go to the slide BEFORE the last slide viewed.

.GotoSlide (.LastSlideViewed.SlideIndex - 1)

 


Change My Colour

This code will change the colour of any shape clicked in slide show mode. This is a good place to start adapting code. Adjust the R, G and B values (currently 255,0,0) to get the colour you want.

Sub changecol(oshp As Shape)
On Error GoTo errhandler
oshp.Fill.ForeColor.RGB = RGB(255, 0, 0)
Exit Sub
errhandler:
MsgBox "Sorry there's an error"
End Sub

Any shape that you want to click should be given an action setting of Run > Macro>changecol


Change Font for Whole Presentation

This vba will save your life when someone produces a presentation with different font styles and colours on every page and because they don't follow the Master you have to change each one individually. This vba will do the job in a tick!. You will need to change the values for font name, size and RGB values for title and body text and maybe set .bold and / or .italic to msotrue. Note only text in Placeholders is converted. Thanks to Petlahev for pointing out that the original code needed to check (Czech!) for HasTextFrame!

Sub allchange()
Dim osld As Slide, oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
'Title text change values as required
If oshp.PlaceholderFormat.Type = 1 Or oshp.PlaceholderFormat.Type = 3 Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
With oshp.TextFrame.TextRange.Font
.Name = "Arial"
.Size = 36
.Color.RGB = RGB(0, 0, 255)
.Bold = msoFalse
.Italic = msoFalse
.Shadow = False
End With
End If
End If
End If
If oshp.PlaceholderFormat.Type = 2 Or oshp.PlaceholderFormat.Type = 7 Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
'Body text change values as required
With oshp.TextFrame.TextRange.Font
.Name = "Arial"
.Size = 24
.Color.RGB = RGB(255, 0, 0)
.Bold = msoFalse
.Italic = msoFalse
.Shadow = False
End With
End If
End If
End If
End If
Next oshp
Next osld
End Sub


UnBold

This code searches placeholders and textboxes in the presentation for BOLD text and un-bolds it

Sub unbold()
Dim osld As Slide
Dim oshp As Shape
Dim oTemp As TextRange
Dim i As Integer
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set oTemp = oshp.TextFrame.TextRange
For i = 1 To Len(oTemp)
If oTemp.Characters(i).Font.Bold = True Then _
oTemp.Characters(i).Font.Bold = False
Next
End If
End If
Next oshp
Next osld
Set oTemp = Nothing
End Sub


Picture Format in 2007

2007 Offers great picture tools. If you have soft shadows, borders etc set up on one picture this code will set all pictures to the same format. ONLY FOR 2007!

Select the pic that is formatted and run!

Sub All_Pics()
'this is for 2007 only
Dim osld As Slide
Dim oshp As Shape
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set oshp = ActiveWindow.Selection.ShapeRange(1)
ActiveWindow.Selection.ShapeRange(1).PickUp
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPicture Then oshp.Apply
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then oshp.Apply
End If
Next oshp
Next osld
End Sub

Full slide Images

Sub Pic_Size()
'resize selection to full page
'note may distort image
Dim oshp As Shape
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set oshp = ActiveWindow.Selection.ShapeRange(1)
With oshp
.LockAspectRatio = False
.Height = ActivePresentation.PageSetup.SlideHeight
.Width = ActivePresentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With
End Sub

 

Jump to a Random Slide

This is the code to jump to a random slide within a given range. Give an action button an action of Run > Macro > randjump to use it.

To generate the random number use this formula:

Number =Int((highest number in range - one less that lowest number)*rnd + lowest number in range)

eg For a number between 4 and 10

number = Int(10-3)*rnd+4) ---OR -- Int(7*rnd +4)

So here's the code to jump to a random slide between 4 and 10

Sub randjump()
' For a random slide between 4 and 10
Const iStart As Integer = 4
Const iEnd As Integer = 10
Dim Inum As Integer
Randomize
Do
Inum = Int((iEnd - iStart + 1) * Rnd + iStart)
Loop Until Inum <> ActivePresentation.SlideShowWindow.View.CurrentShowPosition
ActivePresentation.SlideShowWindow.View.GotoSlide (Inum)
End Sub

Most people will tell you random slide choice can only be done with vba. If vba isn't suitable for your use look at random powerpoint slides without vba

 

Shuffle Part of Presentation

You can use rnd in a similar way to shuffle a section of a presentation. Input the highest and lowest slide numbers to be affected.

Sub shufflerange()
Dim Iupper As Integer
Dim Ilower As Integer
Dim Ifrom As Integer
Dim Ito As Integer
Dim i As Integer
Iupper = InputBox("What is the highest slide number to shuffle")
Ilower = InputBox("What is the lowest slide number to shuffle")
If Iupper > ActivePresentation.Slides.Count Or Ilower < 1 Then GoTo err
For i = 1 To 2*Iupper
Randomize
Ifrom = Int((Iupper - Ilower + 1) * Rnd + Ilower)
Ito = Int((Iupper - Ilower + 1) * Rnd + Ilower)
ActivePresentation.Slides(Ifrom).MoveTo (Ito)
Next i
Exit Sub
err:
MsgBox "Your choices are out of range", vbCritical
End Sub

We now have a FREE Add In which can shuffle all or part on your presentation for you! Works only IN versions from 2002

DOWNLOAD IT HERE, unzip the file, read the PDF

See more vba samples here Table Format Copy and Selective Printing Reverse order

 

 
 

Back to the Index Page

POWERPOINT BLOG

Articles on your favourite sport

Free Microsoft PowerPoint Advice, help and tutorials, Template Links
This website is sponsored by Technology Trish Ltd
© Technology Trish 2007
Registered in England and Wales No.5780175
PowerPoint® is a registered trademark of the Microsoft Corporation