Vba 对调用程序的关键字返回控制

在幻灯片中第一次出现关键字后，我希望被调用的程序结束并将控制权返回给调用程序，以便它移动到下一张幻灯片

此处“退出”子项不起作用，并且显示幻灯片中出现的所有关键字的MsgBox

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

---

exit-sub

将退出

sub-Keywords

并将控制权返回到

sub-Highlightkeywords（）

，该控制权将在循环中继续

您可能希望将

子关键字

转换为

函数关键字作为布尔值

然后在

Keywords

函数的开头设置

Keywords=true

，在

GoTo Normalexit

之前设置

keyworkds=false

此外，这：

Normalexit:
Exit Sub

End Sub

可以更改为：

Normalexit:
End Function

在您的代码中，

Exit Sub

与

End Sub

没有任何不同，因为

End Sub

将在没有退出的情况下直接调用，并且仍然退出

---

您是否正在处理函数关键字的结果

已修改

在

Sub Highlightkeywords（）

中，更改对keywords的调用以处理结果

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

修改2

只要重新阅读你想要的。也许这就是你要找的？回答：最初，您认为调用程序就是调用此程序的程序，但您可能打算在找到关键字后将其移至演示文稿中的下一张幻灯片

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

---

这就是你说的吗？

谢谢你的帮助，伙计。但这也不起作用。我把子关键字改成了函数，也把normalexit改成了函数。但它不起作用。你能帮我修改代码吗？你在处理函数关键字的结果吗？（没有意识到这会很难阅读-改为修改答案）针对应用程序中的每个压力。在压力中为每个SLDMISED做演示。在SLDMISED中为每个shp制作幻灯片。形状如果关键字（shp），则退出子下一个shp下一个SLDMISED下一个压力这就是您所说的？？抱歉。我已经发布了修改后的代码。我不明白函数关键字的概念。明白了，非常感谢你：）是的-看起来像我建议的那样。你能详细说明为什么它不起作用吗？没有运行或没有给出期望的结果？

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