每个段落的第一句

天空飘过啥

麻烦各位帮解决一个问题，选择一个范围，里面的每个段落的第一句话（以句话结束）改为红色。

谢谢哈

凌空一羽

Sub lkyy()
Dim doc As Document, Page_c As Byte, Ipt_start As Long, Ipt_end As Long
Dim Pstart As Long, Pend As Long, MyRange As Range
Set doc = ActiveDocument
Page_c = doc.ComputeStatistics(wdStatisticPages)
Ipt_start = InputBox("请输入起始页", , 1)
Ipt_end = InputBox("请输入结束页", , 2)
If Ipt_start > Page_c Then Exit Sub
If Ipt_end > Page_c Then Exit Sub
Selection.GoTo wdGoToPage, , Ipt_start
Pstart = Selection.Start
If Ipt_end = Page_c Then
    Selection.EndKey unit:=wdStory
    Pend = Selection.End
Else
    Selection.GoTo wdGoToPage, , Ipt_end + 1
    Pend = Selection.Start
End If

Set MyRange = Range(Pstart, Pend)
For i = 1 To MyRange.Paragraphs.Count
    ps = MyRange.Paragraphs(i).Range.Start
    n = 1
    ch = ""
    Do Until ch = "。"
        ch = MyRange.Paragraphs(i).Range.Characters(n)
        n = n + 1
    Loop
    doc.Range(ps, ps + n - 1).Font.ColorIndex = wdDarkRed
Next
End Sub

d)
For i = 1 To MyRange.Paragraphs.Count
    ps = MyRange.Paragraphs(i).Range.Sta?

daibao88

Sub test()
    On Error Resume Next
    Dim i As Integer, paph As Paragraph, str As String
    If Selection.Type = wdSelectionIP Then MsgBox "没有选择": Exit Sub
    For Each paph In Selection.Paragraphs
        str = paph.Range.Text
        i = VBA.InStr(1, str, "。")
        If i Then
            ActiveDocument.Range(paph.Range.Start, paph.Range.Start + i).Font.ColorIndex = wdRed
        End If
    Next
End Sub

天空飘过啥

daibao88 发表于 2020-2-9 09:41
Sub test()
    On Error Resume Next
    Dim i As Integer, paph As Paragraph, str As String

谢谢了，可以！

QQ214189912

1. <blockquote>Sub test()

复制代码

QQ214189912

QQ214189912 发表于 2020-2-9 11:53

1. Sub test()
   
2.     Dim paph As Paragraph
   
3.     For Each paph In ActiveDocument.Paragraphs
   
4.         paph.Range.Sentences(1).Font.ColorIndex = wdRed
   
5.     Next
   
6. End Sub

复制代码

天空飘过啥

QQ214189912 发表于 2020-2-9 11:56

66666，谢谢