Sub 項目検査()
'
' 項目検査 Macro
' 記録日 03/09/07 記録者 岡田
'-------------------------------------------
' 出願書類の項目抜け等を検査する
'-------------------------------------------
Dim SerchWord(35) As String
Dim errSerchWord(35) As String
Dim MsgTitle As String
Dim errNumber As Integer
Dim myRange As Range
Dim i As Integer
Dim errFlg As Integer
Dim MsgBoxString As String
Dim myWildLengs As String
Dim myStringLengs As Integer
MsgTitle = "おしらせ"
errNumber = 1
'--- 願書の検査項目 ---------------------
SerchWord(0) = "【書類名】 {1,}特許願"
SerchWord(1) = "【整理番号】"
SerchWord(2) = "【提出日】"
SerchWord(3) = "【あて先】"
SerchWord(4) = "【国際特許分類】"
SerchWord(5) = "【発明者】"
SerchWord(6) = "【特許出願人】"
SerchWord(7) = "【代理人】"
SerchWord(8) = "【手数料の表示】"
SerchWord(9) = "【予納台帳番号】"
SerchWord(10) = "【納付金額】"
SerchWord(11) = "【提出物件の目録】"
SerchWord(12) = "【物件名】 {1,}特許請求の範囲"
SerchWord(13) = "【物件名】 {1,}明細書"
SerchWord(14) = "【物件名】 {1,}図面"
SerchWord(15) = "【物件名】 {1,}要約書"
SerchWord(16) = "【包括委任状番号】"
'-- 特許請求の範囲の検査項目--------------
SerchWord(17) = "【書類名】 {1,}特許請求の範囲"
SerchWord(18) = "【請求項1】"
'-- 明細書の検査項目 --------------------
SerchWord(19) = "【書類名】 {1,}明細書"
SerchWord(20) = "【発明の名称】"
SerchWord(21) = "【技術分野】"
SerchWord(22) = "【背景技術】"
SerchWord(23) = "【発明の開示】"
SerchWord(24) = "【発明が解決しようとする課題】"
SerchWord(25) = "【課題を解決するための手段】"
SerchWord(26) = "【発明の効果】"
SerchWord(27) = "【発明を実施するための最良の形態】"
SerchWord(28) = "【図面の簡単な説明】"
SerchWord(29) = "【符号の説明】"
'-- 図面/要約書の検査項目 -------------
SerchWord(30) = "【書類名】 {1,}図面"
SerchWord(31) = "【書類名】 {1,}要約書"
SerchWord(32) = "【要約】"
SerchWord(33) = "【課題】"
SerchWord(34) = "【解決手段】"
SerchWord(35) = "【選択図】"
imax = 35
'------------------------------------
Set myRange = ActiveDocument.Range()
For i = 0 To imax
With myRange.Find
.ClearFormatting
.Text = SerchWord(i)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchByte = False
.MatchFuzzy = False
If .Execute = False Then
errFlg = 1
errNumber = errNumber + 1
errSerchWord(i) = SerchWord(i)
End If
End With
Next
'------------------------------------
MsgBoxString = "項目検査を完了しました。 "
If errFlg = 1 Then
MsgBoxString = MsgBoxString + "以下の " +
StrConv(errNumber - 1, vbNarrow) + " 個の項目が見あたらない又は項目の書き方が間違っています。" + vbCrLf
For i = 0 To imax
If errSerchWord(i) <> "" Then
myWildLengs = InStr(errSerchWord(i), "{1,}")
If myWildLengs <> 0 Then 'ワイルドカードがあれば
myStringLengs = Len(errSerchWord(i)) 'ワイルドカードまでの文字数を取得し
errSerchWord(i) = Left(errSerchWord(i), myWildLengs - 1) _
+ " " + Right(errSerchWord(i),
myStringLengs - myWildLengs - 3) 'ワイドカードを削除した文字列を生成する
End If
If Len(MsgBoxString) < 480 Then
MsgBoxString = MsgBoxString + vbCrLf + " " + errSerchWord(i)
Else
MsgBoxString = MsgBoxString + vbCrLf + vbCrLf + " " + "− 以下省略 −"
Exit For
End If
End If
Next
Else
MsgBoxString = MsgBoxString + "異常はありません。"
End If
MsgBox MsgBoxString, , MsgTitle
End Sub
|