Solved

Counting slides in powerpoint that meet a specified condition using vba

Posted on 2014-01-20
3
1,493 Views
Last Modified: 2014-01-27
I have a series of slides which I want to be able to count if they meet a specific condition (and perform other function on ideally). I tried doing this by

activepresentation.slides.shapes.title.name("test").count

but this doesn't work. I then tried to set this up as an array but I can't work out how to do that. I tried the following, but it's not working, as I think I can't define an array this way. I feel like this should be easy but I can't work it out.

Sub arraytest()

Dim ppt As Presentation
Dim s As Slide
Dim scurrent As Slide
Dim arraytest As Variant

Set ppt = ActivePresentation
Set s = ppt.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)

arraytest = Array(ppt.Slides(ActiveWindow.Selection.SlideRange.SlideIndex))

For x = 1 To ppt.Slides.Count Step 1
    If ppt.Slides(x).Shapes.Title.Name = "test" Then
        ActiveWindow.View.GotoSlide (x)
        Set scurrent = ppt.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
    End If

    ReDim Preserve arraytest(UBound(arraytest) + 1)
    arraytest = ppt.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)

Next

MsgBox ppt.Slides.Range(arraytest).Count

End Sub
0
Comment
Question by:jessicasimonk
3 Comments
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 39794340
I think that you have several misconceptions.
This code creates an array of the slide indexes where the Title shape has text = "test"
Sub arraytest()

Dim ppt As Presentation
Dim s As Slide
Dim scurrent As Slide
Dim arraytest() As Integer
Dim x As Integer
Dim p As Integer

Set ppt = ActivePresentation

For x = 1 To ppt.Slides.Count Step 1
    If ppt.Slides(x).Shapes.Title.TextFrame.TextRange = "test" Then
        ReDim Preserve arraytest(p)
        arraytest(p) = x
        p = p + 1
   End If
Next x

MsgBox p & " slides found"

End Sub

Open in new window

0
 

Author Comment

by:jessicasimonk
ID: 39794555
Thank you - I knew I had it completely wrong but I'm a VBA newbie and couldn't work it out
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39798480
Be careful not to have any slide with no title (eg blank) because it will crash.

Also it is probably easier without an array

Sub No_arraytest()
Dim osld As Slide
Dim raySlides() As Long
Dim iCount As Integer
Dim strReport As String
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
If osld.Shapes.Title.TextFrame.TextRange = "test" Then
iCount = iCount + 1
strReport = strReport & "Slide " & osld.SlideIndex & ","
End If
End If
Next osld
Select Case iCount
Case Is > 1
MsgBox iCount & " Slides were found:" & vbCrLf & Left(strReport, Len(strReport) - 1)
Case 1
MsgBox iCount & " Slides was found:" & vbCrLf & Left(strReport, Len(strReport) - 1)
Case 0
MsgBox "None found."
End Select
End Sub
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
The viewer will learn how to edit text. This includes Font, Spacing, Resizing, Color, and other special text options.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now