Set TextRange to start at beginning of current line (PowerPoint 2007 VBA)

Question

Given that the cursor is within some TextRange tr, I would like a Sub that takes tr as an input argument and selects (or returns) a TextRange that starts at the start of the current line containing tr.startand ends at the next instance of a "." or ":"). Ideally this would work with an arbitrary TextRange or with the current selection (ActiveWindow.Selection.TextRange). NOTE: it maybe be that tr.Length = 0 (nothing actually selected).

Answer 1

I've answered the question by implementing a loop through all paragraphs in the text frame to find the paragraph containing the cursor, then through the lines in that paragraph to find the line containing the cursor. Then selecting text in the line starting at the first character and extending until the first of a ".", ":" or the end of the line. Then applying the "style" to the selected text. That code is below (some comments follow the code).

I am still hoping for a more elegant solution that doesn't require searching.

Option Explicit

Sub StyleRunInApply()

' Apply the run-in style to current selection (assumed to be a text range). If
' no characters are selected, apply from the beginning of the current line to
' the first of "." or ":" or the end of the current line.
'
' The "run-in style" is defined to be bold with Accent2 color of the current
' master theme.
    
    Dim iLine As Long
    Dim lenth As Long
    Dim line As TextRange
    Dim pgf As TextRange
    Dim tr As TextRange
    Dim thme As OfficeTheme
   
    Set tr = ActiveWindow.Selection.TextRange
    
    If tr.Length = 0 Then
        
        ' Loop through pgfs in parent text frame to find our line--
        ' the first pgf that ends at or beyond the cursor.
        
        For Each pgf In tr.Parent.TextRange.Paragraphs
            If pgf.Start + pgf.Length > tr.Start Or _
               pgf.Start + pgf.Length > tr.Parent.TextRange.Length Then GoTo L_foundPgf
        Next pgf    ' (If fall through, pgf will be the final pgf in the frame.)
L_foundPgf:

        ' Find last line in pgf that starts before the cursor.
        
        While iLine < pgf.Lines.Count And pgf.Lines(iLine + 1).Start < tr.Start
            iLine = iLine + 1
        Wend
        
        Set line = pgf.Lines(iLine)
        
        ' Now look in the line for a ":" or "." and reset tr from the start of
        ' the line up to and including the first of a ":" or "." or the end of
        ' line.
        
        lenth = line.Length
        
        If Not line.Find(":") Is Nothing Then
            lenth = line.Find(":").Start - line.Start + 1
            
        ElseIf Not line.Find(".") Is Nothing Then
            If line.Find(".").Start - line.Start + 1 < lenth Then
                lenth = line.Find(".").Start - line.Start + 1
            End If
        End If
        
        Set tr = line.Characters(1, lenth)
    End If
   
    ' Set the finally selected text to the style!
    
    Set thme = ActivePresentation.SlideMaster.Theme
    tr.Font.Color = thme.ThemeColorScheme(msoThemeAccent2)
    tr.Font.Bold = True
    
End Sub 'StyleRunInApply

Three comments on the code:

• Improvements welcome.
• A variation that set the end position of the text to be selected rather than the length seems to be about the same in terms of comprehensibility, size, and elegance.
• In defense of the GoTo: I use it only as part of a substitute for "missing" language features, in this case, an Exit For, and then, for such exits, only immediately following the Then, which is the reason for not having a block follow the Then.