将文本范围设置为从当前行的开头开始 (PowerPoint 2007 VBA)



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

我已经通过实现文本框架中所有段落的循环来查找包含光标的段落,然后通过该段落中的行来查找包含光标的行来回答这个问题。然后选择行中的文本,从第一个字符开始,一直延伸到"."、":"或行尾的第一个字符。然后将"样式"应用于所选文本。该代码如下(代码后面有一些注释)。

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

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

关于代码的三条评论:

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

相关内容

最新更新