转到下一个命名形状

Question

所以我创建了一个宏来添加一个"todo-shape"。现在我想创建一个宏，转到演示文稿中的下一个待办事项形状。我对 PowerPoint 中的 VBA 很陌生，但在下面创建了一些代码。

有什么让它发挥作用的想法吗？

    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

Answer 1

试试这个：

 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

Answer 2

我设法创建了一个解决方案。

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

转到下一个命名形状

Go to next named shape

powerpoint

vba