Question

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

此处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

Answer 1

exit sub退出Sub Keywords并将控件返回Sub Highlightkeywords()，这将继续循环播放。

您可能希望将Sub Keywords变为Function Keywords As Boolean 然后在Keywords = true函数的开头设置Keywords，在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

Answer 2

Public Sub Auto_Open()

    Const STRFOLDER As String = "D:\GIS-Projekte_Sync\"
    Dim objShell As Object, objFolder As Object
    Dim bytIndex As Byte, intColumn As Integer, lngRow As Long
    Dim varName, arrHeaders(37)
    If Dir(STRFOLDER, 16) = "" Then
        MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(STRFOLDER)
    intColumn = 1
    For bytIndex = 0 To 37
        arrHeaders(bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
        Cells(1, intColumn + bytIndex) = arrHeaders(bytIndex)
    Next
    Rows(1).Font.Bold = True
    lngRow = 2
    For Each varName In objFolder.Items
        For bytIndex = 0 To 37
            Cells(lngRow, intColumn + bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
        Next
        lngRow = lngRow + 1
    Next
    Columns.AutoFit
    Set objShell = Nothing
    Set objFolder = Nothing
    Application.ScreenUpdating = True
End Sub

这是你说的那个吗？

关键字返回控制到调用程序

2 个答案: