我是靠谱客的博主 还单身向日葵,这篇文章主要介绍Word VBA自动排版(5)- 专利具体实施方式批量增加附图标记,现在分享给大家,希望可以做个参考。

专利说明书在撰写时,如遇到附图标记过多时,往往需要手动替换各部件以增加附图标记,较为耗时,通过下述代码可对文中的所有部件快速标记,通常只需几秒。

复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
Sub 自动增加附图标记() Dim fea(0 To 9, 0 To 9, 0 To 9) As String i = 1 Do With Selection.find .Text = "[!0-9]" & i & "[!^1-^127]" .ClearFormatting .Forward = True .Wrap = wdFindContinue .MatchWildcards = True End With Selection.find.Execute If Selection.find.Found And i <= 9 Then Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=2 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend fea(i, 0, 0) = Selection.Text i = i + 1 Else: i = i + 1 End If If i = 10 Then Exit Do End If Loop i = 1 j = 1 Do With Selection.find .Text = "[!0-9]" & i & "" & j & "[!^1-^127]" .ClearFormatting .Forward = True .Wrap = wdFindContinue .MatchWildcards = True End With Selection.find.Execute If Selection.find.Found And j <= 9 Then Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend fea(i, j, 0) = Selection.Text j = j + 1 Else: i = i + 1 j = 1 If i = 10 Then Exit Do End If End If Loop i = 1 j = 1 k = 1 Do With Selection.find .Text = "[!0-9]" & i & "" & j & "" & k & "[!^1-^127]" .ClearFormatting .Forward = True .Wrap = wdFindContinue .MatchWildcards = True End With Selection.find.Execute If Selection.find.Found And k <= 9 Then Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=4 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend fea(i, j, k) = Selection.Text k = k + 1 Else: j = j + 1 k = 1 If i = 10 Then Exit Do End If If j = 10 Then i = i + 1 j = 1 k = 1 End If End If Loop i = 0 j = 0 Do i = i + 1 If i = 10 Then Exit Do ElseIf fea(i, 0, 0) <> "" And i <= 9 Then With Selection.find .Text = "" & fea(i, j, 0) & "" .Replacement.Text = "" & fea(i, 0, 0) & i & "" .ClearFormatting .Forward = True .Wrap = wdFindContinue End With Selection.find.Execute Replace:=wdReplaceAll End If Loop i = 0 j = 0 Do j = j + 1 If j = 10 Then i = i + 1 j = 0 ElseIf i = 10 Then Exit Do ElseIf fea(i, j, 0) <> "" And j <= 9 Then With Selection.find .Text = "" & fea(i, j, 0) & "" .Replacement.Text = "" & fea(i, j, 0) & i & j & "" .ClearFormatting .Forward = True .Wrap = wdFindContinue End With Selection.find.Execute Replace:=wdReplaceAll End If Loop i = 0 j = 0 k = 0 Do k = k + 1 If k = 10 Then j = j + 1 k = 0 ElseIf j = 10 Then i = i + 1 j = 0 k = 0 ElseIf i = 10 Then Exit Do ElseIf fea(i, j, k) <> "" And k <= 9 Then With Selection.find .Text = "" & fea(i, j, k) & "" .Replacement.Text = "" & fea(i, j, k) & i & j & k & "" .ClearFormatting .Forward = True .Wrap = wdFindContinue End With Selection.find.Execute Replace:=wdReplaceAll End If Loop End Sub

上述代码总体运行过程如下:
1)先在文中查找带有附图标记的各部件,并赋值给fea()三维数组;
2)然后继续在具体实施例中根据fea()中的各元素查找所对应的附图标记名称,并增加相应的图号

注:
1)该代码还比较初级,仅能识别三位数以内的图号;
2)部件名称不得含有非中文的字符;
3)部件名称不能含有另一部件名称,否则会出错;
例如,部件21四连杆组件,则部件211不能采用四连杆或连杆等名称;
4)遇到相同部件名称可命名为第一、第二,第三……,但不能用罗马数字I,II,III,否则会出错。

使用时word的格式应为:
附图标记:这行不能省略
1XX 各标记后必须用回车换行,否则无法识别
11xx
2YY
21第一yy
211yyg
212yyh
22第二yy
3ZZ
31zzt
32zztt

具体实施方式:
粘贴需要增加标号的内容

除了这两部分不要粘贴其他内容,除了这两部分不要粘贴其他内容,除了这两部分不要粘贴其他内容。

————————THE END——————

最后

以上就是还单身向日葵最近收集整理的关于Word VBA自动排版(5)- 专利具体实施方式批量增加附图标记的全部内容,更多相关Word内容请搜索靠谱客的其他文章。

本图文内容来源于网友提供,作为学习参考使用,或来自网络收集整理,版权属于原作者所有。
点赞(73)

评论列表共有 0 条评论

立即
投稿
返回
顶部