作者：韩建伟

亲爱的小伙伴，大家有没有被专利申请文件的补正所烦恼，本文通过使用宏可以检查出一种会导致补正出现的情况。我呢，只是一个专利代理人，所以文中涉及的代码只是供小伙伴们参考，还有很多需要改进的地方，大家共同研究，共同进步。

Word中的宏在哪里？

在WPS中，点击"开发工具"，点击VB编辑器，将本文中的代码（完整代码在文章的最后）拷贝到编辑器中，点击保存。

在Word中，点击开发工具中的"Visual Basic"，在打开的窗口左栏依次点击"Normal""Microsoft Word 对象""ThisDocument"，就可以在右侧出现空白窗口，将文中的代码拷贝到空白处即可，点击保存。如果没有"开发工具"则打开"Word选项"，在"常用"一栏中将"在功能区显示开发工具"选中，点击确定即可。

下图是WPS的图：

关闭VB编辑器，点开宏。

发现多了一个"PIC"，惊不惊喜？

选择"PIC"，点击"运行"即可。

那么，这个宏是做什么用的呢？

我分析了一些补正，发现有相当一部分的补正是具体实施例中出现了某个图，但是附图说明书中没有。例如，具体实施方式中出现了"图5"，但是，附图说明中并没有"图5"。这个宏就是用来提示具体实施方式中出现了哪些图在附图说明中没有的。

原理是什么？

我简单介绍一下代码中的逻辑，抛砖引玉，希望大家写出更好的代码，改正我代码中一些傻乎乎的地方。

SearchStr1 = "具体实施方式"
SearchStr2 = "附图说明"

For i = 1 To ActiveDocument.Paragraphs.Count
If (InStr(ActiveDocument.Paragraphs(i).Range.Text, SearchStr1) = 0) Then
Else
SslNum = i
Exit For
End If
Next i

For是一个循环，ActiveDocument.Paragraphs.Count是当前文档中一共有多少个段落，For循环从第一段落开始找，直到找到包括SearchStr1的第一段落，SearchStr1是什么？就是"具体实施方式"。说简单点，这段代码就是找到第一个包括"具体实施方式"这几个字的段落是第几段，SslNum就记录了这个段落。

For j = 1 To ActiveDocument.Paragraphs.Count
If (InStr(ActiveDocument.Paragraphs(j).Range.Text, SearchStr2) = 0) Then
Else
FtsmNum = j
Exit For
End If
Next j

同理，这个段落是为了找到第一个包括"附图说明"这几个字的段落是第几段，FtsmNum就记录了这个段落。

For k = (FtsmNum + 1) To (SslNum - 1)
Ftsm = Ftsm + ActiveDocument.Paragraphs(k).Range.Text
Next k

这一段同样做了一个循环，把"附图说明"和"具体实施方式"之间的每个段落中的文字都赋值给Ftsm。

For g = (SslNum + 1) To ActiveDocument.Paragraphs.Count
Ssl = Ssl + ActiveDocument.Paragraphs(g).Range.Text
Next g

同理，这一段把"具体实施方式"到文尾的每个段落中的文字都赋值给Ssl。

也就是说，上述两段把"附图说明"和"具体实施方式"中的文字都拷贝到了两个变量中（这似乎看起来效率并不是很高的做法）。

下面到了关键部分，这部分的内容的核心思想是找到具体实施方式中的"图"字，找到"图"字之后，找到该字后面的一个到两个字。

例如，这段话："需要说明的是，本发明的说明书和权利要求书及上述附图中的术语"第一"、"第二"等是用于区别类似的对象，而不必用于描述特定的顺序或先后次序。例如，图1中的第一以及图2中的第二。应该理解这样使用的数据在适当情况下可以互换，以便这里描述的本发明的实施例能够以除了在这里图示或描述的那些以外的顺序实施"。

下面的代码就是只要找到这段文字中的"图"字，然后再向后查找1个或2个字符。这段代码中找的内容是"图中""图1""图2""图示"以及"图中的""图1中""图2中""图示或"。找到这个文字之后，判断哪些是图的名字，判断方式很简单，"图"字后面第一个字是数字就是图的名字，例如，图1和图2，并且，后面第一个字是数字以及后面第二个是字符的也是图的名字，例如，图1b。

找到这些图的名字之后，去"附图说明"中找这些图的名字，没有找到就提示。

好，现在看代码:

For r = 1 To 60 /*做一个循环，我估计具体实施方式中不会有超过60个图的名字，所以就用60，如果嫌少就用100，当然，也可以通过一个函数读取一个究竟有多个少图字，大家可以改一下*/
p = InStr(Ssl, "图") /*找图字*/
If Val(Mid(Ssl, p + 1, 1)) > 0 Then/*根据图字后面是不是有数字判断是不是图的名字*/
TuNum1 = Mid(Ssl, p, 2)
TuNum2 = Mid(Ssl, p, 3)

If InStr(Ftsm, TuNum1) = 0 Then/*在附图说明中查找两字的图的名字，例如：图1、图2等*/
MsgBox "具体实施方式中"" & TuNum1 & ""在附图说明中没有"/*没有找到就提示*/
End If

If InStr(Ftsm, TuNum2) = 0 And (Val(Mid(Ssl, p + 2, 1)) > 0 Or (Asc(Mid(Ssl, p + 2, 1)) > 64 And Asc(Mid(Ssl, p + 2, 1)) < 123)) Then/*在附图说明中查找三个字的图的名字，例如：图1a、图2b等*/
MsgBox "具体实施方式中"" & TuNum2 & ""在附图说明中没有"/*没有找到就提示*/
End If
End If
Ssl = Mid(Ssl, (p + 1), (Len(Ssl) - p - 1)) /*找下一个图字*/
Next r
/*为了容错还可以加上p是否大于0的判断*/

上述代码中/**/中的内容是注释。

同理，也可以检查附图说明中有的图号在具体实施方式中没有的。需要说明的是，在一些旧版本机器上运行速度可能会稍微慢一点。

通过上述宏可以查找一些简单的错误，大家也可以编写一些查找其他错误的代码，一起来消灭补正！

附完整代码如下：

Sub PIC()
Dim SearchStr1
Dim SearchStr2
Dim SslNum
Dim FtsmNum
Dim Ftsm
Dim Ssl
Dim p
Dim TuNum1
Dim TuNum2

SearchStr1 = "具体实施方式"
SearchStr2 = "附图说明"

For i = 1 To ActiveDocument.Paragraphs.Count
If (InStr(ActiveDocument.Paragraphs(i).Range.Text, SearchStr1) = 0) Then
Else
SslNum = i
Exit For
End If
Next i

For j = 1 To ActiveDocument.Paragraphs.Count
If (InStr(ActiveDocument.Paragraphs(j).Range.Text, SearchStr2) = 0) Then
Else
FtsmNum = j
Exit For
End If
Next j

For k = (FtsmNum + 1) To (SslNum - 1)
Ftsm = Ftsm + ActiveDocument.Paragraphs(k).Range.Text
Next k

For g = (SslNum + 1) To ActiveDocument.Paragraphs.Count
Ssl = Ssl + ActiveDocument.Paragraphs(g).Range.Text
Next g

For r = 1 To 100
p = InStr(Ssl, "图")

If p > 0 Then
If Val(Mid(Ssl, p + 1, 1)) > 0 Then

TuNum1 = Mid(Ssl, p, 2)
TuNum2 = Mid(Ssl, p, 3)

If InStr(Ftsm, TuNum1) = 0 Then

MsgBox "具体实施方式中" & TuNum1 & "在附图说明中没有"

End If

If Len(Ssl) >= (p + 2) Then

If InStr(Ftsm, TuNum2) = 0 And (Val(Mid(Ssl, p + 2, 1)) > 0 Or (Asc(Mid(Ssl, p + 2, 1)) > 44 And Asc(Mid(Ssl, p + 2, 1)) < 123)) Then

MsgBox "具体实施方式中 " & TuNum2 & " 在附图说明中没有"

End If

End If

End If
If (Len(Ssl) - p - 1) >= 0 Then
Ssl = Mid(Ssl, (p + 1), (Len(Ssl) - p))
End If
'MsgBox Ssl
Else: Exit For
End If
Next r

Dim Ssl1
Dim Ftsm1

For a = (FtsmNum + 1) To (SslNum - 1)
Ftsm1 = Ftsm1 + ActiveDocument.Paragraphs(a).Range.Text
Next a

For b = (SslNum + 1) To ActiveDocument.Paragraphs.Count
Ssl1 = Ssl1 + ActiveDocument.Paragraphs(b).Range.Text
Next b
'MsgBox Ssl1
'MsgBox Ftsm1

For x = 1 To 100
y = InStr(Ftsm1, "图")
'MsgBox y

If y > 0 Then
If Val(Mid(Ftsm1, y + 1, 1)) > 0 Then

TuNum11 = Mid(Ftsm1, y, 2)
TuNum22 = Mid(Ftsm1, y, 3)

If InStr(Ssl1, TuNum11) = 0 Then
MsgBox "附图说明中的" & TuNum11 & "在具体实施方式中没有"
End If

If InStr(Ssl1, TuNum11) > 0 And (Asc(Mid(Ssl1, InStr(Ssl1, TuNum11) + 2, 1)) > 47 And Asc(Mid(Ssl1, InStr(Ssl1, TuNum11) + 2, 1)) < 58) Then
MsgBox "附图说明中的" & TuNum11 & "在具体实施方式中没有"
End If

If Len(Ftsm1) >= (y + 2) Then

If InStr(Ssl1, TuNum22) = 0 And (Val(Mid(Ftsm1, y + 2, 1)) > 0 Or (Asc(Mid(Ftsm1, y + 2, 1)) > 44 And Asc(Mid(Ftsm1, y + 2, 1)) < 123)) Then

MsgBox "附图说明中的 " & TuNum22 & " 在具体实施方式中没有"

End If

End If

End If
If (Len(Ftsm1) - y - 1) >= 0 Then
Ftsm1 = Mid(Ftsm1, (y + 1), (Len(Ftsm1) - y))
End If
Else: Exit For
End If
Next x

MsgBox "未检查出其他错误,检查完毕! 韩一星出品！"

End Sub