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——————