将 TextRange 设置为从当前行的开头开始 (PowerPoint 2007 VBA)

Question

鉴于光标在某个TextRange tr 内，我想要一个Sub，它将tr 作为输入参数并选择（或返回）一个TextRange，它从当前行的开头包含tr.startand 以“.”的下一个实例结束要么 ”：”）。理想情况下，这将适用于任意 TextRange 或当前选择 (ActiveWindow.Selection.TextRange)。注意：可能是 tr.Length = 0（实际上没有选择）。

Answer 1

我通过在文本框架中的所有段落中执行循环以查找包含光标的段落，然后通过该段落中的行查找包含光标的行来回答了这个问题。然后选择行中的文本，从第一个字符开始，一直延伸到“.”、“:”中的第一个或行尾。然后将“样式”应用于所选文本。该代码如下（一些 cmets 遵循该代码）。

我仍然希望有一个不需要搜索的更优雅的解决方案。

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

代码上的三个cmets：

• 欢迎改进。
• 设置要选择的文本的结束位置而不是长度的变体在可理解性、大小和优雅方面似乎大致相同。
• 为 GoTo 辩护：我仅将其用作“缺失”语言功能的替代品的一部分，在本例中为 Exit For，然后，对于此类退出，仅紧跟在 Then 之后，即是Then后面没有块的原因。