' Hilfsprozedur für ListSubs, die einmal mit "Sub" und einmal mit "Function"
' aufgerufen wird
Private Sub ListSubsHelper(ByRef vTextBox As RichTextBox, _
    ByRef vCombo As ComboBox, ByVal sKeyWord As String)
 
    On Error Resume Next
    Dim lPos As Long, lFPos As Long, sFuncName As String
    ' suche erstes Auftreten von sKeyWord
    lPos = InStr(1, vTextBox.Text, sKeyWord, vbTextCompare)
    While lPos > 0
        If InStr(lPos, vTextBox.Text, "(") > 0 Then
            ' nach sKeyWord tritt ein "(" auf (als Begrenzer für Funktionsnamen)
            lFPos = lPos + Len(sKeyWord) + 1
            sFuncName = Trim(Mid(vTextBox.Text, lFPos, _
                InStr(lPos, vTextBox.Text, "(") - lFPos))
            If InStr(1, sFuncName, " ") > 0 Then
                ' kein gültiger Funktionsname
            Else
                If InStr(1, sFuncName, vbNewLine) > 0 Then
                    ' kein gültiger Funktionsname
                Else
                    vCombo.AddItem sFuncName
                End If
            End If
        End If
        ' nächstes Auftreten von sKeyWord suchen
        lPos = InStr(lPos + 1, vTextBox.Text, sKeyWord, vbTextCompare)
    Wend
End Sub
 
' listet alle Funktionen und Prozeduren auf
Private Sub ListSubs(ByRef vTextBox As RichTextBox, ByRef vCombo As ComboBox)
    vCombo.Clear
    ' alle Funktionen auflisten
    ListSubsHelper vTextBox, vCombo, "function"
    ' alle Subs auflisten
    ListSubsHelper vTextBox, vCombo, "sub"
End Sub
 
' prüft, ob in der Zeile vor dem Funktionsnamen "Sub" oder "Function" steht
Private Function JumpToSubHelper(ByRef vTextBox As RichTextBox, ByVal lPos As _
  Long, ByVal sKeyWord As String) As Boolean
    On Error Resume Next
    Dim lSPos As Long, sTemp As String
    lSPos = InStrRev(vTextBox.Text, sKeyWord, lPos, vbTextCompare)
    If lSPos > 0 Then
        sTemp = Mid(vTextBox.Text, lSPos, lPos - lSPos)
        If InStr(1, sTemp, vbNewLine) > 0 Then
            ' ist nicht die Funktionsdeklaration
        Else
            ' ist die funktionsdeklaration
            JumpToSubHelper = True
        End If
    End If
End Function
 
' springt zu der gewünschten Funktion/Sub
Private Sub JumpToSub(ByRef vTextBox As RichTextBox, ByVal sFuncName As String)
    On Error Resume Next
    Dim lPos As Long, bIsDeclaration As Boolean, lNPos As Long
    ' erstes Auftreten des Funktionsnamens suchen suchen
    lPos = InStr(1, vTextBox.Text, sFuncName, vbTextCompare)
    While lPos > 0
        ' vor dem Funktionsnamen muss entweder "Sub" oder "Function" stehen
        If JumpToSubHelper(vTextBox, lPos, "sub") Then
            bIsDeclaration = True
        Else
            If JumpToSubHelper(vTextBox, lPos, "function") Then
                bIsDeclaration = True
            End If
        End If
        If bIsDeclaration Then
            ' Suche Anfang der Zeile
            lNPos = InStrRev(vTextBox.Text, vbNewLine, lPos)
            lPos = IIf(lNPos > 0, lNPos + 2, 1)
            vTextBox.SelStart = lPos - 1
            lPos = Len(vTextBox.Text)
        End If
        ' nächstes Auftreten vom Funktionsnamen suchen
        lPos = InStr(lPos + 1, vTextBox.Text, sFuncName, vbTextCompare)
    Wend
End Sub

ListSubs RichText1, Combo1

JumpToSub RichText1, "Funktionsname"

JumpToSub RichTextBox1, Combo1.Text

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.