a段落处理

1
Sub 段落处理(control As IRibbonControl) '段落-段落处理-
2
    Application.ScreenUpdating = False
3
    For Each pg In Selection.Paragraphs
4
        If pg.Range.Information(wdWithInTable) = False Then
5
            '-------------------------------------------------------------------------
6
            If pg.OutlineLevel = wdOutlineLevel1 Then '如果是1级标题用此格式
7
                With pg.Range.ParagraphFormat
8
                    .LeftIndent = CentimetersToPoints(0)   '左缩进
9
                    .RightIndent = CentimetersToPoints(0)  '右缩进
10
                    .SpaceBefore = 2.5        '段前 2.5磅等于0.5行,如果你的单位为行,则这里乘5
11
                    .SpaceBeforeAuto = False
12
                    .SpaceAfter = 2.5         '段后
13
                    .SpaceAfterAuto = False
14
                    .LineSpacingRule = wdLineSpace1pt5   '行距,单倍 wdLineSpaceSingle   1.5倍 wdLineSpace1pt5     两倍 wdLineSpaceDouble
15
                    .Alignment = wdAlignParagraphCenter  '对齐方式  左对齐:wdAlignParagraphLeft  右对齐:wdAlignParagraphRight  居中:wdAlignParagraphCenter
16
                    .FirstLineIndent = CentimetersToPoints(0)  '首行缩进
17
                    .CharacterUnitLeftIndent = 0
18
                    .CharacterUnitRightIndent = 0
19
                    .CharacterUnitFirstLineIndent = 0
20

21
                End With
22
                With pg.Range
23
                    .Font.NameFarEast = "黑体"   '中文
24
                    .Font.NameAscii = "Times New Roman"   '西文
25
                    .Font.NameOther = "Times New Roman"   '西文
26
                    .Font.Size = 20          '字号三号
27
                    .Font.Bold = True        '加粗      不加粗填false
28
                End With
29
                '-------------------------------------------------------------------------
30
            ElseIf pg.OutlineLevel = wdOutlineLevel2 Then '如果是2级标题用此格式
31
                With pg.Range.ParagraphFormat
32
                    .LeftIndent = CentimetersToPoints(0)
33
                    .RightIndent = CentimetersToPoints(0)
34
                    .SpaceBefore = 2.5
35
                    .SpaceBeforeAuto = False
36
                    .SpaceAfter = 2.5
37
                    .SpaceAfterAuto = False
38
                    .LineSpacingRule = wdLineSpace1pt5
39
                    .Alignment = wdAlignParagraphJustify '两端对齐
40
                    .FirstLineIndent = CentimetersToPoints(0)
41
                    .CharacterUnitLeftIndent = 0
42
                    .CharacterUnitRightIndent = 0
43
                    .CharacterUnitFirstLineIndent = 0
44

45
                End With
46
                With pg.Range
47
                    .Font.NameFarEast = "黑体"
48
                    .Font.NameAscii = "Times New Roman"
49
                    .Font.NameOther = "Times New Roman"
50
                    .Font.Size = 18          '字号四号
51
                    .Font.Bold = True
52

53
                End With
54
                '-------------------------------------------------------------------------
55
            ElseIf pg.OutlineLevel = wdOutlineLevel3 Then  '如果是3级标题用此格式
56
                With pg.Range.ParagraphFormat
57
                    .LeftIndent = CentimetersToPoints(0)
58
                    .RightIndent = CentimetersToPoints(0)
59
                    .SpaceBefore = 2.5
60
                    .SpaceBeforeAuto = False
61
                    .SpaceAfter = 2.5
62
                    .SpaceAfterAuto = False
63
                    .LineSpacingRule = wdLineSpace1pt5
64
                    .Alignment = wdAlignParagraphLeft
65
                    .FirstLineIndent = CentimetersToPoints(0)
66
                    .CharacterUnitLeftIndent = 0
67
                    .CharacterUnitRightIndent = 0
68
                    .CharacterUnitFirstLineIndent = 0
69

70
                End With
71
                With pg.Range
72
                    .Font.NameFarEast = "黑体"
73
                    .Font.NameAscii = "Times New Roman"
74
                    .Font.NameOther = "Times New Roman"
75
                    .Font.Size = 16          '字号小四
76
                    .Font.Bold = True
77

78
                End With
79
                '-------------------------------------------------------------------------
80
            ElseIf pg.OutlineLevel = wdOutlineLevel4 Then  '如果是4级标题用此格式
81
                With pg.Range.ParagraphFormat
82
                    .LeftIndent = CentimetersToPoints(0)
83
                    .RightIndent = CentimetersToPoints(0)
84
                    .SpaceBefore = 2.5
85
                    .SpaceBeforeAuto = False
86
                    .SpaceAfter = 2.5
87
                    .SpaceAfterAuto = False
88
                    .LineSpacingRule = wdLineSpace1pt5
89
                    .Alignment = wdAlignParagraphJustify
90
                    .FirstLineIndent = CentimetersToPoints(0)
91
                    .CharacterUnitLeftIndent = 0
92
                    .CharacterUnitRightIndent = 0
93
                    .CharacterUnitFirstLineIndent = 0
94

95
                End With
96
                With pg.Range
97
                    .Font.NameFarEast = "仿宋"
98
                    .Font.NameAscii = "Times New Roman"
99
                    .Font.NameOther = "Times New Roman"
100
                    .Font.Size = 16          '字号小四
101
                    .Font.Bold = True
102
                End With
103
                '------------------------------------------------------------------------- 下面是5级以及正文的样式设置
104
            Else
105
                With pg.Range.ParagraphFormat
106
                    .LeftIndent = CentimetersToPoints(0)
107
                    .RightIndent = CentimetersToPoints(0)
108
                    .SpaceBefore = 2.5
109
                    .SpaceBeforeAuto = False
110
                    .SpaceAfter = 2.5
111
                    .SpaceAfterAuto = False
112
                    .LineSpacingRule = wdLineSpace1pt5
113
                    .Alignment = wdAlignParagraphJustify
114
                    .FirstLineIndent = CentimetersToPoints(0.35)  '首行缩进2
115
                    .CharacterUnitLeftIndent = 0
116
                    .CharacterUnitRightIndent = 0
117
                    .CharacterUnitFirstLineIndent = 2  '首行缩进2
118

119
                End With
120
                With pg.Range
121
                    .Font.NameFarEast = "仿宋"
122
                    .Font.NameAscii = "Times New Roman"
123
                    .Font.NameOther = "Times New Roman"
124
                    .Font.Size = 14          '字号四号
125
                    .Font.Bold = False
126
                End With
127
            End If
128
        End If
129
    Next
130
    Application.ScreenUpdating = True
131
End Sub
132
Sub 表前单位格式(control As IRibbonControl) '
133
    For Each pg In Selection.Paragraphs
134
        pg.IndentFirstLineCharWidth -10000
135
        pg.IndentFirstLineCharWidth 2
136
        pg.Range.Font.Bold = False
137
        With pg.Range.ParagraphFormat
138
            .LeftIndent = CentimetersToPoints(0)
139
            .RightIndent = CentimetersToPoints(0)
140
            .SpaceBefore = 0
141
            .SpaceBeforeAuto = False
142
            .SpaceAfter = 0
143
            .SpaceAfterAuto = False
144
            .LineSpacingRule = wdLineSpaceSingle
145
            .Alignment = wdAlignParagraphJustify
146
            .FirstLineIndent = CentimetersToPoints(0)
147
            .CharacterUnitLeftIndent = 0
148
            .CharacterUnitRightIndent = 0
149
            .CharacterUnitFirstLineIndent = 0
150
            .LineUnitBefore = 0
151
            .LineUnitAfter = 0
152
        End With
153
        With pg.Range
154
            .Font.NameFarEast = "宋体"
155
            .Font.NameAscii = "Times New Roman"
156
            .Font.NameOther = "Times New Roman"
157
            .Font.Size = 10.5         '字号五号
158
            .Font.Bold = False
159
            .ParagraphFormat.Alignment = wdAlignParagraphRight
160
        End With
161
        With pg.Range.ParagraphFormat
162
            .SpaceBefore = 0
163
            .SpaceBeforeAuto = False
164
            .SpaceAfter = 0
165
            .SpaceAfterAuto = False
166
        End With
167
    Next
168
    Application.ScreenUpdating = True
169
End Sub
170
Sub 表后注释格式(control As IRibbonControl) '
171
    For Each pg In Selection.Paragraphs
172
        pg.IndentFirstLineCharWidth -10000
173
        pg.IndentFirstLineCharWidth 2
174
        pg.Range.Font.Bold = False
175
        With pg.Range.ParagraphFormat
176
            .LeftIndent = CentimetersToPoints(0)
177
            .RightIndent = CentimetersToPoints(0)
178
            .SpaceBefore = 0
179
            .SpaceBeforeAuto = False
180
            .SpaceAfter = 0
181
            .SpaceAfterAuto = False
182
            .LineSpacingRule = wdLineSpaceSingle
183
            .Alignment = wdAlignParagraphJustify
184
            .FirstLineIndent = CentimetersToPoints(0)
185
            .CharacterUnitLeftIndent = 0
186
            .CharacterUnitRightIndent = 0
187
            .CharacterUnitFirstLineIndent = 0
188
            .LineUnitBefore = 0
189
            .LineUnitAfter = 0
190
        End With
191
        With pg.Range
192
            .Font.NameFarEast = "宋体"
193
            .Font.NameAscii = "Times New Roman"
194
            .Font.NameOther = "Times New Roman"
195
            .Font.Size = 10        '字号10
196
            .Font.Bold = False
197
            .ParagraphFormat.Alignment = wdAlignParagraphJustify
198
        End With
199
        With pg.Range.ParagraphFormat
200
            .SpaceBefore = 0
201
            .SpaceBeforeAuto = False
202
            .SpaceAfter = 0
203
            .SpaceAfterAuto = False
204
        End With
205
    Next
206
    Application.ScreenUpdating = True
207
End Sub
208
Sub 自动编号(control As IRibbonControl)  '针对样式（一）
209
    '先选择一片范围再运行代码,会将例如"(一)"此样式的编号换为自动编号,"()"为中文全角符号
210
    '注意只有段落开头为"(一)"样式的编号会替换,段中的编号则不会
211
    Dim r As Range, P As Range, tpf, NF, NS, LI, FI
212
    '================================================== 配置区
213
    tpf = "（[一二三四五六七八九十]@）"  '通配符
214
    NF = "（%1）"   '编号格式,%1为编号本身,不能动,只需要编辑%1旁边的格式,比如'(一)'为'（%1）' 或者 '1、'为 '%1、' 或者 '第一章'为'第%1章'
215
    NS = wdListNumberStyleSimpChinNum3  '编号的样式:wdListNumberStyleArabic阿拉伯数字    wdListNumberStyleSimpChinNum3中文数字
216
    LI = CentimetersToPoints(0)    '左缩进
217
    FI = CentimetersToPoints(0.74)   '首行缩进
218
    '================================================== 配置区
219
    Application.ScreenUpdating = False
220
    If Selection.Type = wdSelectionIP Then
221
        MsgBox "请选择范围！"
222
        Exit Sub
223
    Else
224
        Set r = Selection.Range
225
        Set P = Selection.Range
226
    End If
227
    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)  '设置编号格式
228
        .NumberFormat = NF
229
        .TrailingCharacter = wdTrailingNone
230
        .NumberStyle = NS
231
        .NumberPosition = 0
232
        .Alignment = wdListLevelAlignLeft
233
        .TextPosition = 0
234
        .TabPosition = wdUndefined
235
        .ResetOnHigher = 0
236
        .StartAt = 1
237
        .LinkedStyle = ""
238
    End With
239
    ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
240
    With r.Find
241
        .ClearFormatting
242
        .Text = tpf
243
        .Forward = True
244
        .MatchWildcards = True
245
        Do While .Execute
246
            With .Parent
247
                pat = .Text
248
                If .End > P.End Then Exit Do
249
                ast = Asc(ActiveDocument.Range(Start:=.Start - 1, End:=.Start))
250
                If ast = 13 Or ast = 12 Then
251
                    .ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
252
                        ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
253
                        True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
254
                        wdWord10ListBehavior
255
                    With .ParagraphFormat
256
                        .SpaceBeforeAuto = False
257
                        .SpaceAfterAuto = False
258
                        .LeftIndent = LI
259
                        .FirstLineIndent = FI
260
                    End With
261
                    If .Text = pat Then
262
                        .Delete
263
                    End If
264
                End If
265
                .Start = .End
266
            End With
267
        Loop
268
    End With
269
    Application.ScreenUpdating = True
270
    MsgBox "完成"
271
End Sub
272
Sub 编号转文本(control As IRibbonControl)
273
    Dim kgslist As List
274
    i = MsgBox("点击确定则将该文档下所有编号转为文本", 1)
275
    If i = 1 Then
276
        For Each kgslist In ActiveDocument.Lists
277
            kgslist.ConvertNumbersToText
278
        Next
279
    End If
280
End Sub