Reputation: 29

On keyword return control to calling program

After the first occurrence of the keyword in the slide I want the called program to end and return control to the calling program so that it will move to the next slide.

Here the Exit Sub is not working and MsgBox is shown for all occurrences of the keyword in the slide.

Option Explicit
Global sldmissed As Slide
Global c As Long

Sub Highlightkeywords()
 Dim Pres As Presentation
 Dim shp As Shape
 c = 0
 For Each Pres In Application.Presentations
      For Each sldmissed In Pres.Slides
         For Each shp In sldmissed.Shapes
             Call Keywords(shp)
         Next shp
     Next sldmissed
 Next Pres
 MsgBox c

End Sub

Sub Keywords(shp As Object)

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I, K, X, n As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList

    TargetList = Array("1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th", "10th", "11th", "12th", "13th", "14th", "15th", "16th", "17th", "18th", "19th", "20th", "21st", "22nd", "23rd", "24th", "25th", "26th", "27th", "28th", "29th", "30th", "31st", "etc", ":00", ".00", "a.m.", "p.m.", "number", "US", "USA", "$")

    With shp

        If shp.HasTable Then

            For iRows = 1 To shp.Table.Rows.Count
                For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                    Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                    For I = LBound(TargetList) To UBound(TargetList)
                        Set rngFound = txtRng.Find(FindWhat:=TargetList(I), MatchCase:=True, wholewords:=True)
                        Do While Not rngFound Is Nothing
                            n = rngFound.Start + 1
                            With rngFound
                                If rngFound.Font.Color.RGB = RGB(255, 0, 0) Then
                                    sldmissed.Select
                                    c = c + 1
                                    MsgBox "Slide: " & sldmissed.SlideNumber, vbInformation
                                    Set rngFound = txtRng.Find(TargetList(I), n, MatchCase:=True, wholewords:=True)

                                    **GoTo Normalexit**
                                Else
                                    **GoTo Normalexit**

                                End If
                            End With
                        Loop
                    Next
                Next
            Next

        End If

    End With


    Select Case shp.Type
     Case msoTable

     Case msoGroup
        For X = 1 To shp.GroupItems.Count
            Call Keywords(shp.GroupItems(X))
        Next X

     Case 21
         For X = 1 To shp.Diagram.Nodes.Count
           Call Keywords(shp.GroupItems(X))
         Next X

     Case Else

        If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange
            For I = LBound(TargetList) To UBound(TargetList)
                Set rngFound = txtRng.Find(FindWhat:=TargetList(I), MatchCase:=True, wholewords:=True)
                Do While Not rngFound Is Nothing
                    n = rngFound.Start + 1
                    With rngFound
                        If rngFound.Font.Color.RGB = RGB(255, 0, 0) Then
                            sldmissed.Select
                            c = c + 1
                            MsgBox "Slide: " & sldmissed.SlideNumber, vbInformation
                            Set rngFound = txtRng.Find(TargetList(I), n, MatchCase:=True, wholewords:=True)
                            **GoTo Normalexit**

                        Else
                            **GoTo Normalexit**

                        End If
                    End With
                Loop
            Next
        End If

    End Select

Normalexit:
Exit Sub

End Sub

Upvotes: 0

Answers (2)

Brian Riley

Reputation: 946

The exit sub will exit out of Sub Keywords and return control to Sub Highlightkeywords() which will continue in it's loop.

You probably want to turn Sub Keywords into Function Keywords As Boolean then set Keywords = true in the beginning of the Keywords function, and keyworkds = false before the GoTo Normalexit.

Also, this:

Normalexit:
Exit Sub

End Sub

Can be changed to this:

Normalexit:
End Function

In your code, Exit Sub doesn't do anything different than End Sub as End Sub would have been called directly without the exit and still exited.

Are you handling the result of Function Keywords?

MODIFIED

in Sub Highlightkeywords(), change the call to keywords to handle the result.

For Each Pres In Application.Presentations
      For Each sldmissed In Pres.Slides
         For Each shp In sldmissed.Shapes
             if Keywords(shp) then
               exit sub
         Next shp
     Next sldmissed
 Next Pres

Modified 2

Just re-read what you want. Maybe this is what you're looking for? Answered originally thinking of calling program as the program that called this one - but perhaps you meant to have it move to the next slide in the presentation once the keyword is found?

For Each Pres In Application.Presentations
      For Each sldmissed In Pres.Slides
         For Each shp In sldmissed.Shapes
             if Keywords(shp) then break 'This will go to next slide
         Next shp
     Next sldmissed
 Next Pres

Upvotes: 0

Pandi Muthu

Reputation: 29

Option Explicit
Global sldmissed As Slide
Global c As Long
Sub Highlightkeywords()
 Dim Pres As Presentation
 Dim shp As Shape
 c = 0
 For Each Pres In Application.Presentations
      For Each sldmissed In Pres.Slides
         For Each shp In sldmissed.Shapes
            If keywords(shp) Then
            Exit Sub
         Next shp
     Next sldmissed
 Next Pres

End Sub

Function keywords(shp As Object) As Boolean

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I, K, X, n As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList

    keywords = True


    TargetList = Array("1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th", "10th", "11th", "12th", "13th", "14th", "15th", "16th", "17th", "18th", "19th", "20th", "21st", "22nd", "23rd", "24th", "25th", "26th", "27th", "28th", "29th", "30th", "31st", "etc", ":00", ".00", "a.m.", "p.m.", "number", "US", "USA", "$")

    With shp

    If shp.HasTable Then

                For iRows = 1 To shp.Table.Rows.Count
                    For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                        Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                                 For I = LBound(TargetList) To UBound(TargetList)
                                    Set rngFound = txtRng.Find(FindWhat:=TargetList(I), MatchCase:=True, wholewords:=True)
                                    Do While Not rngFound Is Nothing
                                    n = rngFound.Start + 1
                                    With rngFound
                                        If rngFound.Font.Color.RGB = RGB(255, 0, 0) Then
                                            sldmissed.Select
                                            c = c + 1
                                            MsgBox "Slide: " & sldmissed.SlideNumber, vbInformation
                                            Set rngFound = txtRng.Find(TargetList(I), n, MatchCase:=True, wholewords:=True)

                                            keywords = False
                                            GoTo Normalexit


                                        Else
                                             keywords = False
                                            GoTo Normalexit



                                    End If
                             End With
                            Loop
                        Next
                    Next
                Next

            End If

            End With


           Select Case shp.Type
            Case msoTable


            Case msoGroup
                For X = 1 To shp.GroupItems.Count
                    Call keywords(shp.GroupItems(X))
                Next X

            Case 21
                For X = 1 To shp.Diagram.Nodes.Count
                    Call keywords(shp.GroupItems(X))
                Next X

            Case Else

                If shp.HasTextFrame Then
                Set txtRng = shp.TextFrame.TextRange
                    For I = LBound(TargetList) To UBound(TargetList)
                       Set rngFound = txtRng.Find(FindWhat:=TargetList(I), MatchCase:=True, wholewords:=True)
                       Do While Not rngFound Is Nothing
                             n = rngFound.Start + 1
                             With rngFound
                               If rngFound.Font.Color.RGB = RGB(255, 0, 0) Then
                                        sldmissed.Select
                                        c = c + 1
                                        MsgBox "Slide: " & sldmissed.SlideNumber, vbInformation
                                        Set rngFound = txtRng.Find(TargetList(I), n, MatchCase:=True, wholewords:=True)
                                        keywords = False
                                        GoTo Normalexit


                                Else
                                        keywords = False
                                        GoTo Normalexit




                                    End If
                             End With
                        Loop
                    Next
                  End If

    End Select

Normalexit:
End Function

Is this the one you said?

Upvotes: 0

On keyword return control to calling program

Answers (2)

Related Questions