查找特定格式段落的VBA

13907933959

413191246se 发表于 2018-3-18 14:11
....这个”

师傅好！
啊、是这样呀！谢谢师傅的详释！

13907933959

duquancai 发表于 2018-3-18 10:37

杜前辈好！
OK了！谢谢！

leedun

duquancai 发表于 2018-3-18 10:37

杜先生，如果要设置字体段落的上一段是表格就不完美了

413191246se

* 以下不太完美的《自动排版》代码仅供楼主参考：（提请特别注意《标题2345》自动设置宏，即Title2345）

1. Sub 公文()
   
2.     Dim doc As Document, t As Table, j As Long, k As Long
   
3.     Set doc = ActiveDocument
   
4.     ActiveWindow.View.Type = wdPrintView
   
5.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
   
6.     With doc
   
7.         With .Content.Find
   
8.             .Execute "^13", , , 0, , , , , , "^p", 2
   
9.             .Execute "^11", , , 0, , , , , , "^p", 2
   
10.             .Parent.ListFormat.ConvertNumbersToText
    
11.         End With
    
12.         If .Tables.Count = 0 Then
    
13.             .Select
    
14.             正文样式
    
15.         Else
    
16.             For Each t In .Tables
    
17.                 With t.Range
    
18.                     .Rows.WrapAroundText = False
    
19.                     .Rows.Alignment = wdAlignRowCenter
    
20.                     .Font.Name = "仿宋_GB2312"
    
21.                     .Font.Name = "Times New Roman"
    
22.                     .Font.Color = wdColorDarkRed
    
23.                 End With
    
24.             Next
    
25.             If .Paragraphs(1).Range.Information(wdWithInTable) = False Then
    
26.                 .Tables(1).Range.Previous.Select
    
27.                 Selection.HomeKey unit:=wdStory, Extend:=wdExtend
    
28.                 Selection.MoveEnd unit:=wdCharacter, Count:=1
    
29.                 正文样式
    
30.             End If
    
31.             k = .Tables.Count
    
32.             For j = 1 To k
    
33.                 If j = k Then Exit For
    
34.                 .Range(Start:=.Tables(j).Range.End, End:=.Tables(j + 1).Range.Start).Select
    
35.                 正文样式
    
36.             Next j
    
37.             .Tables(k).Range.Next.Select
    
38.             Selection.EndKey unit:=wdStory, Extend:=wdExtend
    
39.             正文样式
    
40.         End If
    
41.     End With
    
42. 
    
43.     Title2345
    
44. 
    
45.     Auto1
    
46. 
    
47.     Selection.HomeKey unit:=wdStory
    
48. End Sub
    
49. Sub 正文样式()
    
50.     Dim i As Paragraph, r As Range
    
51.     With Selection
    
52.         .ClearFormatting
    
53.         CommandBars.FindControl(ID:=122).Execute
    
54.         CommandBars.FindControl(ID:=123).Execute
    
55.         With .Font
    
56.             .Name = "仿宋_GB2312"
    
57.             .Name = "Times New Roman"
    
58.             .Size = 16
    
59.             .Color = wdColorBlue
    
60.             .Kerning = 0
    
61.             .DisableCharacterSpaceGrid = True
    
62.         End With
    
63.         With .ParagraphFormat
    
64.             .LineSpacing = LinesToPoints(1.25)
    
65.             .CharacterUnitFirstLineIndent = 2
    
66.             .AutoAdjustRightIndent = False
    
67.             .DisableLineHeightGrid = True
    
68.         End With
    
69.         Set r = .Range
    
70.         For Each i In r.Paragraphs
    
71.             If Len(i.Range) = 1 And Asc(i.Range) = 13 Then i.Range.Delete
    
72.         Next
    
73.     End With
    
74. End Sub
    
75. Sub Auto1()
    
76.     With ActiveDocument.Paragraphs(1).Range
    
77.         .InsertParagraphAfter
    
78.         .InsertParagraphBefore
    
79.         .Style = wdStyleHeading1
    
80.         With .ParagraphFormat
    
81.             .SpaceBeforeAuto = False
    
82.             .SpaceAfterAuto = False
    
83.             .SpaceBefore = 0
    
84.             .SpaceAfter = 0
    
85.             .LineSpacing = LinesToPoints(1.15)
    
86.             .Alignment = wdAlignParagraphCenter
    
87.             .AutoAdjustRightIndent = False
    
88.             .DisableLineHeightGrid = True
    
89.         End With
    
90.         .Paragraphs(1).Range.Font.Size = 21
    
91.         .Paragraphs(3).Range.Font.Size = 26
    
92.     End With
    
93. End Sub
    
94. Sub Title2345()
    
95.     Dim mt, reg As Object, n&, m&, L&, ostr$, sr$, r1$, r2$, r3$, r4$
    
96.     ostr = Replace(ActiveDocument.Content, Chr(7), "")
    
97.     sr = "一二三四五六七八九十百零千〇"
    
98.     r1 = "^[" & sr & "]+、"
    
99.     r2 = "^[(（]\s*[" & sr & "]+\s*[)）]"
    
100.     r3 = "^\d+[、.．]"
     
101.     r4 = "^[(（]\s*\d+\s*[)）]"
     
102.     Set reg = CreateObject("vbscript.regexp")
     
103.     With reg
     
104.         .Global = True
     
105.         .MultiLine = True
     
106.         .Pattern = "" & r2 & "|" & r1 & "|" & r4 & "|" & r3 & ""
     
107.         For Each mt In .Execute(ostr)
     
108.             m = mt.FirstIndex
     
109.             n = mt.Length
     
110.             With ActiveDocument.Range(m, m + n)
     
111.                 If Not .Information(wdWithInTable) Then
     
112.                     .Expand 4
     
113.                     L = Len(.Text)
     
114.                     .Collapse
     
115.                     If .MoveWhile(sr, L) > 0 Then
     
116.                         .Expand 4
     
117.                         .Style = "标题 2"
     
118.                         .Font.ColorIndex = 6
     
119.                     ElseIf .MoveWhile("(（", L) > 0 Then
     
120.                         If .MoveWhile(sr, L) > 0 Then
     
121.                             .Expand 4
     
122.                             .Style = "标题 3"
     
123.                             With .Font
     
124.                                 .Name = "楷体_GB2312"
     
125.                                 .Name = "Times New Roman"
     
126.                                 .ColorIndex = 5
     
127.                             End With
     
128.                         Else
     
129.                             .Expand 4
     
130.                             .Style = "标题 5"
     
131.                             With .Font
     
132.                                 .Name = "仿宋_GB2312"
     
133.                                 .Name = "Times New Roman"
     
134.                                 .ColorIndex = 12
     
135.                             End With
     
136.                         End If
     
137.                     Else
     
138.                         .Expand 4
     
139.                         .Style = "标题 4"
     
140.                         With .Font
     
141.                             .Name = "仿宋_GB2312"
     
142.                             .Name = "Times New Roman"
     
143.                             .ColorIndex = 11
     
144.                         End With
     
145.                     End If
     
146.                     If .Sentences.Count = 1 Then
     
147. '                        If v Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
     
148.                     Else
     
149.                         With .Font
     
150.                             .Name = "仿宋_GB2312"
     
151.                             .Name = "Times New Roman"
     
152.                             .Bold = False
     
153.                             .Color = wdColorBlue
     
154.                         End With
     
155.                         With .Sentences(1).Font
     
156.                             .Bold = True
     
157.                             .Color = wdColorBrown
     
158.                         End With
     
159.                     End If
     
160.                     With .Font
     
161.                         .Size = 16
     
162.                         .Kerning = 0
     
163.                         .DisableCharacterSpaceGrid = True
     
164.                     End With
     
165.                     With .ParagraphFormat
     
166.                         .SpaceBeforeAuto = False
     
167.                         .SpaceAfterAuto = False
     
168.                         .SpaceBefore = 0
     
169.                         .SpaceAfter = 0
     
170.                         .LineSpacing = LinesToPoints(1.25)
     
171.                         .CharacterUnitFirstLineIndent = 2
     
172.                         .AutoAdjustRightIndent = False
     
173.                         .DisableLineHeightGrid = True
     
174.                         .KeepWithNext = False
     
175.                         .KeepTogether = False
     
176.                     End With
     
177.                 End If
     
178.             End With
     
179.         Next
     
180.     End With
     
181. End Sub

复制代码

ke3088

413191246se 发表于 2018-3-25 02:10
* 以下不太完美的《自动排版》代码仅供楼主参考：（提请特别注意《标题2345》自动设置宏，即Title2345）

好的，谢谢！413191246se老师