CODEWITHSUNDEEP
vbapowerpoint
Fredrik Bois
Fredrik Bois

Reputation: 33

Go to next named shape

So I have created a macro to add a "todo-shape". Now I'd like to create a macro that goesto the next todo-shape in the presentation. I am quite new to VBA in PowerPoint but have created some code below.

Any ideas how to get it to work?

    Sub TodoSelectNext()

    Dim i As Integer

    i = ActiveWindow.Selection.SlideRange.SlideIndex

    Do While i < ActivePresentation.Slides.Count

        ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex + 1).Select

        ActivePresentation.Slides(1).Shapes("todo").Select

        i = i + 1

    Loop

    End Sub

Upvotes: 0

Views: 63

Answers (2)

Fredrik Bois
Fredrik Bois

Reputation: 33

I managed to create a solution.

Sub TodoSelectNext()

    Dim i As Integer
    Dim shp As Shape

    i = ActiveWindow.Selection.SlideRange.SlideIndex

    Do While i < ActivePresentation.Slides.Count

        ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex + 1).Select

        For Each shp In ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex).Shapes
            If shp.Name = "todo" Then
                Exit Sub
            End If
        Next shp

        i = i + 1

    Loop

End Sub



Sub TodoSelectPrevious()

    Dim i As Integer
    Dim shp As Shape

    i = ActiveWindow.Selection.SlideRange.SlideIndex

    Do While i > 1

        ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex - 1).Select

        For Each shp In ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex).Shapes
            If shp.Name = "todo" Then
                Exit Sub
            End If
        Next shp

        i = i - 1

    Loop

End Sub

Upvotes: 1

Steve Rindsberg
Steve Rindsberg

Reputation: 14810

Try this instead: 

 Sub TodoSelectNext()

    Dim i As Long  ' SlideIndex is a Long, not an Integer
    Dim oSh As Shape

    i = ActiveWindow.Selection.SlideRange.SlideIndex + 1

    If i < ActivePresentation.Slides.Count Then

        Do While i <= ActivePresentation.Slides.Count
            ActiveWindow.View.GotoSlide (i)
            On Error Resume Next
            Set oSh = ActivePresentation.Slides(i).Shapes("todo")
            ' Did we find the shape there?
            If Not oSh Is Nothing Then
                oSh.Select
                Exit Sub
            Else
                i = i + 1
            End If
        Loop

    End If

End Sub

Upvotes: 0

Related Questions