Question

我已经疯了，我确定错误就在我面前，我无法看到它。感谢所有帮助调试下面的陈述。

我在ppt演示文稿中有多张幻灯片。在某些幻灯片中，有一个星形形状，以及一个带有文本“Hold”或“Yearly”的文本框。我希望只有在没有“Hold”或“Yearly”的文本框时才能改变星星的颜色。

Sub Set_Star_Shape_Color_Green_Test()
    Dim PPApp As Object ' As PowerPoint.Application
    Dim PPPres As Object ' As PowerPoint.Presentation
    Dim PPSlide As Object ' As PowerPoint.Slide
    Dim iShpCnt1 As Integer
    Dim iShpCnt2 As Integer
    Dim iShpCnt3 As Integer
    Dim iSlideCnt As Integer
    Dim iBoxTopPos As Integer
    Dim sHold As String
    Dim sStar As String
    Dim sTbox As String
    Dim sTColor As String
    Dim oShp As Shape

    Set PPApp = GetObject(, "Powerpoint.Application")
    Set PPPres = PPApp.ActivePresentation
    Set PPSlide = PPPres.Slides _
        (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    iShpCnt0 = PPSlide.Shapes.Count
    For iShpCnt1 = 1 To iShpCnt0    'PPSlide.Shapes.Count
        iBoxTopPos = 260
        ' iSlideCnt = 2 removed
        sHold = ""
        sStar = ""

        iShpCnt1 = 1
        For iShpCnt1 = 1 To PPSlide.Shapes.Count
            If iShpCnt1 <= PPSlide.Shapes.Count Then
                **Set oSh = PPApp.ActivePresentation.Slides(iSlideCnt).Shapes(iShpCnt1)  ' this is where i am getting the integer out of range error**
                If oSh.Name.Text Like "*Hold*" Or oSh.Name.Text Like "*Yearly*" Then
                    sHold = oSh.Name
                End If
                If oSh.Name Like "*Star*" Then
                    sStar = oSh.Name
                End If
            End If

        Next

        For iShpCnt2 = 1 To iShpCnt0 ' this fixed the error
            Set oSh = PPApp.ActivePresentation.Slides(iSlideCnt).Shapes(iShpCnt2)
            If oSh.Name Like "*Star*" And sHold = "" Then
                oSh.Fill.ForeColor.RGB = RGB(50, 205, 50) ' change the color to green
            End If
        Next

        ' go to next slide
        If PPSlide.SlideIndex + 1 < PPPres.Slides.Count Then
            PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex + 1
            Set PPSlide = PPPres.Slides _
                (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex + 1)
        End If

    Next

    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing

End Sub

Answer 1

您正在将迭代器设置为两个。

For iSlideCnt = 1 To PPPres.Slides.Count
    iBoxTopPos = 260
    iSlideCnt = 2 <--- right here

如果您只有一张幻灯片，它将超出范围。

用于下一个语句的“整数超出范围”错误

1 个答案: