红色段落加句号的代码怎么调整

zhgj007

各位老师，我想在红色段落的结束位置加句号，改编了一段代码，但有几个问题不知道怎么调整：

1.句号会加在最左边而不是右边  

2.空段也会加句号  

3.段落结束有标点符号的，也加了句号

以下为代码内容：

Sub 红色段落结束加句号()

    Dim para As Paragraph

    For Each para In ActiveDocument.Paragraphs

       If para.Range.Font.Color = RGB(255, 0, 0) Then  '判断是否红色段落

       If Len(para.Range.Text) > 0 Then  '判断是否空段

            If Right(para.Range.Text, 1) <> "。. ； ， " Then  '判断段尾是否有标点符号

             para.Range.Text = para.Range.Text & "。"  '没有标点符号的加句号

           End If

            End If

        End If

    Next para

End Sub

饮冰e士

If Right(para.Range.Text, 1) <> "。. ； ， "
这个条件估计会始终成立的吧

墨策

Sub 红色段落结束加句号()
    Dim para As Paragraph, 范围 As Range
    For i = 1 To ActiveDocument.Paragraphs.Count
        If ActiveDocument.Paragraphs(i).Range.Font.Color = RGB(255, 0, 0) Then
            If Len(ActiveDocument.Paragraphs(i).Range.TEXT) > 1 Then
                If InStr(Right(ActiveDocument.Paragraphs(i).Range.TEXT, 2), "。") = 0 And _
                InStr(Right(ActiveDocument.Paragraphs(i).Range.TEXT, 2), ".") = 0 And _
                InStr(Right(ActiveDocument.Paragraphs(i).Range.TEXT, 2), "；") = 0 And _
                InStr(Right(ActiveDocument.Paragraphs(i).Range.TEXT, 2), "，") = 0 Then
                    Set 范围 = ActiveDocument.Paragraphs(i).Range
                    范围.End = 范围.End - 1
                    范围.InsertAfter "。"
                End If
            End If
        End If
    Next
End Sub

墨策

代码审核中

weiyingde

试试这个，看能达到要求不。
若达到目标，赏朵小花。
Sub 红色段落结束加句号()
    Dim para As Paragraph
    isr = "。. ； ， "
    ActiveDocument.Content.Find.Execute " ^13", , , , , , , , , , "^p", 2
    For Each para In ActiveDocument.Paragraphs
       If para.Range.Font.Color = RGB(255, 0, 0) Then  '判断是否红色段落
       If Len(para.Range.Text) > 2 Then  '判断是否空段
            With ActiveDocument.Range(para.Range.Start, para.Range.End - 1)
                 sr1 = .Text
                 sr2 = Right(sr1, 1)
                 If InStr(isr, sr2) = 0 Then
                    .Text = sr1 & "。"
                 End If
            End With
            End If
        End If
    Next para
End Sub

weiyingde

ActiveDocument.Content.Find.Execute " ^13”, , ,, , , , , , ,“^13"
测试有些问题，改为
ActiveDocument.Content.Find.Execute "([ ]@)(^13), , ,1 , , , , , , , \2"

batmanbbs

zhgj007

墨策 发表于 2025-1-31 20:44
代码审核中

老师的代码非常棒，一次成功。请问老师，若是连续的红色段落，只在最后一段末尾加句号，该再怎么处理？

zhgj007

weiyingde 发表于 2025-1-31 21:24
ActiveDocument.Content.Find.Execute " ^13”, , ,, , , , , , ,“^13"
测试有些问题，改为
ActiveDocu ...

谢谢老师的回复，您的代码，如果段落结束是公式编辑器编辑的内容，则没有加句号。

zhgj007

batmanbbs 发表于 2025-2-1 00:15

谢谢老师的回复。不知道是否我抄的代码有问题，不执行。
Sub test()


With ActiveDocument.Content.Find
.Text = "([! 。 ; ," & Chr(13) & "])(^13)"
.Font.ColorIndex = wdRed
.MatchWildcards = True
.Replacement.Text = "\1。\2"
.Execute Replace:=wdReplaceal1
End With
End Sub