【发布时间】：2016-01-23 14:21:12
【问题描述】：
在幻灯片中第一次出现关键字后，我希望被调用程序结束并将控制权返回给调用程序，以便它移动到下一张幻灯片。
这里的 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
【问题讨论】：
标签： vba powerpoint