Word VBA自动排版（5）- 专利具体实施方式批量增加附图标记

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

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 VBA自动排版（5）- 专利具体实施方式批量增加附图标记所遇到的程序开发问题。

如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。