Sub 删除段首空格()

Dim i As Integer

For i = 1 To ActiveDocument.Paragraphs.Count

    ActiveDocument.Paragraphs(i).Range.Select

    Call DelSpacesAheadPara

    Call 设置段落格式之缩进(0, 0, 0)

    Debug.Print ActiveDocument.Paragraphs(i).OutlineLevel, ActiveDocument.Paragraphs(i).Range.Font.Name

Next i

End Sub

Sub 设置段落格式()

Dim i As Integer

Dim flag As Boolean

Application.ScreenUpdating = False

For i = 1 To ActiveDocument.Paragraphs.Count

    Debug.Print ActiveDocument.Paragraphs(i).Range.Text

    If ActiveDocument.Paragraphs(i).Range.Text = "参考文献^p" Then

        Exit For '仅设置参考文献以前的段落

    End If

    '正文宋体的段落 颜色和缩进设置 蓝色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "宋体" Then

        ActiveDocument.Paragraphs(i).Range.Select

        ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdBlue

        Call 设置段落格式之缩进(0, 0, 2)

    End If

    '楷体_GB2312的段落颜色和缩进设置 红色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "楷体_GB2312" Then

        ActiveDocument.Paragraphs(i).Range.Select

        ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdRed

        Call 设置段落格式之缩进(2, 0, 2)

    End If

    '非单一字体的段落 颜色和缩进设置 粉色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "" Then

        ActiveDocument.Paragraphs(i).Range.Select

        ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdPink

        Call 设置段落格式之缩进(0, 0, 2)

    End If

Next i

Application.ScreenUpdating = True

End Sub

Sub 设置段落格式之缩进(LIndent, RIndent, FIndent)

    With Selection.ParagraphFormat

        .CharacterUnitLeftIndent = LIndent

        .CharacterUnitRightIndent = RIndent

        .CharacterUnitFirstLineIndent = FIndent

        .LeftIndent = CentimetersToPoints(LIndent)

        .RightIndent = CentimetersToPoints(RIndent)

        .FirstLineIndent = CentimetersToPoints(FIndent)

    End With

End Sub

Private Sub DelSpacesAheadPara()

'删除段首空格

 

    If Len(Selection.Text) < 2 Then Exit Sub

    On Error Resume Next

 

    Selection.MoveStart unit:=wdCharacter, Count:=-1    '向前移动一个字符，包含前回车符

    Call FindReplaceChar(Selection, "^p^w", "^p", wdFindStop, bByte:=False)

    If Selection.Start > ActiveDocument.Range.Start Then _

        Selection.MoveStart unit:=wdCharacter, Count:=1 '非起始位置

 

End Sub

Private Sub FindReplaceChar(ByVal objSel As Object, ByVal strFind As String, _

    ByVal strReplace As String, ByVal FindWrap As Integer, _

    Optional ByVal bWild As Boolean = False, Optional ByVal bByte As Boolean = True)

'执行查找替换操作

 

    objSel.Find.ClearFormatting

    objSel.Find.Replacement.ClearFormatting

    With objSel.Find

        .Text = strFind

        .Replacement.Text = strReplace

        .Forward = True

        .Wrap = FindWrap  'wdFindStop:停止,替换选定部分,若没选中,则默认替换至文档末尾

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = bByte

        .CorrectHangulEndings = False

        .MatchWildcards = bWild

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    objSel.Find.Execute Replace:=wdReplaceAll

    ActiveDocument.Activate

    

End Sub