关键字返回控制调用程序

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

此处Exit Sub不起作用，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

来源

2016-01-23 Pandi Muthu

的exit sub将退出出Sub Keywords和返回控制Sub Highlightkeywords()将继续在它的循环。

你可能要将Sub Keywords成Function Keywords As Boolean 然后设置在Keywords函数的开始Keywords = true，并keyworkds = false的GoTo Normalexit之前。

而且，这样的：

Normalexit: 
Exit Sub 

End Sub

可以改变这一点：

Normalexit: 
End Function

在你的代码，Exit Sub不会做任何事情比End Sub作为End Sub不同会被直接调用，而不退出并仍然退出。

您是否正在处理Function Keywords的结果？

改进

在Sub Highlightkeywords()，改变调用关键字来处理结果。

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

来源

2016-01-23 14:31:21

感谢您的帮助伴侣。但是这也不起作用。我将Sub关键字更改为函数，并且也更改了normalexit。但它不工作。你能帮助我修改代码吗？ –

你正在处理'Function Keywords'的结果吗？（没想到会这样难读 - 修改回答代替）对于每个普雷斯在Application.Presentations 对于每个sldmissed在Pres.Slides 对于每个SHP在sldmissed.Shapes 如果关键词（SHP），然后退出sub Next shp Next sldmissed Next Pres –

这是你说的吗？ –

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

这是你说的吗？

来源

2016-01-23 16:20:21

是的 - 这看起来像我的建议。 –

谢谢。但它不工作的伙伴:( –

你能详细说明为什么它不工作？不运行或不会给出预期的结果？ –

关键字返回控制调用程序

回答

相关问题