JIS-X0208-1997のチェック関数

特許明細書の文字コード

　特許明細書に書くことが許されている文字コードは、JIS-X0208です。これ以外の文字を書くと、電子出願ソフトによって弾かれてしまいます。例えば丸付き文字①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳、ローマ数字ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅭⅯ、㈱㎝⊿∑などです。また、「高」の異体字の「髙」とかもそうですね。
しかし、これらの文字は、ついつい明細書を作成する際に使われてしますようです。そこで、JIS-X0208に適合しない文字をチェックするプログラムを作成いたしました。

開発言語

　開発言語は、お手軽かんたんなワードＶＢＡです。沢山のサンプルプログラムが落ちているし、多くの書籍は出ているし、・・・ただ、ソースコードの秘匿性がないのと、デバッグ機能がいまいちですが。
　

関数紹介

ＶＢＡは内部で文字列をユニコードで持っていますので、ユニコードをJISに変換する関数を作成しました。ここでは、JIS <-> ユニコードの変換関数と、SJIS <-> ユニコードの変換関数を書いていますが、実際に使うのは ユニコードをJISに変換する　ADODB_Encode_JIS関数だけです。
　この関数を作成するにあたり、ADODB.Streamによる文字コード変換のサンプル(VB6)を参考とさせて戴きました。多謝。

Public Function ADODB_Encode_JIS(ByRef strUni As String) As Byte()
    ADODB_Encode_JIS = ADODB_Encode("ISO-2022-JP", strUni)
End Function
Public Function ADODB_Decode_JIS(ByRef byteData() As Byte) As String
    ADODB_Decode_JIS = ADODB_Decode("ISO-2022-JP", byteData)
End Function

Public Function ADODB_Encode_SJIS(ByRef strUni As String) As Byte()
    ADODB_Encode_SJIS = ADODB_Encode("Shift_JIS", strUni)
End Function
Public Function ADODB_Decode_SJIS(ByRef byteData() As Byte) As String
    ADODB_Decode_SJIS = ADODB_Decode("Shift_JIS", byteData)
End Function

Public Function ADODB_Encode(ByVal cset As String, ByVal strData As String) As Byte()
    Dim objStream As Object

    On Error GoTo ErrorHandler
    Set objStream = CreateObject("ADODB.Stream")

    objStream.Open
    objStream.Type = adTypeText
    objStream.Charset = cset
    objStream.WriteText strData

    objStream.Position = 0
    objStream.Type = adTypeBinary

    Select Case UCase(cset)
      Case "UNICODE", "UTF-16"
        objStream.Position = 2
      Case "UTF-8"
        objStream.Position = 3
    End Select
    ADODB_Encode = objStream.Read
    Exit Function

ErrorHandler:
    If Not objStream Is Nothing Then
        If (objStream.State And adStateOpen) = adStateOpen Then
            objStream.Close
        End If
    End If
    Set objStream = Nothing
    MsgBox "エラーコード:" & Err.Number & vbCrLf & Err.Description
End Function

そして、JIS文字列に変換すると、区と点とを取り出して、JIS-X0208の表と照合して、True/Falseを返すだけです。
　また、以下の関数を作るにあたり、「.NET 文字列がJIS X 0208 漢字第二水準までで構成されているかをチェックする」の記事は大変に参考になりました。多謝。特許明細書では、第２区の第９４点の「◯」が使えないので除去しましたが、あとは殆どそのまま移植です。

　余談ですが、インターネット出願ソフト 全機能版 操作マニュアル（第03.10版）の付録編に記載されたJIS-X0208の表は、「区」とあるべきところが「句」となっていますね。

Public Function IsJISKanjiLevel2(ByRef targetBytes() As Byte) As Boolean
    If UBound(targetBytes) <> 7 Then
        IsJISKanjiLevel2 = False
        exit function　　' 2018/8/24追加
    End If
    Dim 区 As Integer
    区 = targetBytes(3) - &H20
    
    Dim 点 As Integer
    点 = targetBytes(4) - &H20
    
    IsJISKanjiLevel2 = False
    
    Select Case 区
        Case 1
            Select Case 点
            Case 1 To 94
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 2
            Select Case 点
            Case 1 To 14, 26 To 33, 42 To 48, 60 To 74, 82 To 89
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 3
            Select Case 点
            Case 16 To 25, 33 To 58, 65 To 90
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 4
            Select Case 点
            Case 1 To 83
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 5
            Select Case 点
            Case 1 To 86
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 6
            Select Case 点
            Case 1 To 24, 33 To 56
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 7
            Select Case 点
            Case 1 To 33, 49 To 81
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 8
            Select Case 点
            Case 1 To 32
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 16 To 46, 48 To 83
            Select Case 点
            Case 1 To 94
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 47
            Select Case 点
            Case 1 To 51
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
        Case 84
            Select Case 点
            Case 1 To 6
                IsJISKanjiLevel2 = True
                Exit Function
            End Select
    End Select
End Function

（８月２４日：最初のIF文は、8か否かではなく、７か否かで判断しなければいけませんので修正しました。VBAのUboundは配列数を返すのではなく、最大のインデクスを返すものです。しかも、そのあとに関数を抜けていなかった不具合がありましたので、これも修正しました。）

　そして、ユニコード文字列を受け付けて、判定結果を True/Falseで返すIsUniKanjiLevel2関数を作成いたしました。引数の文字列を各文字に分解して、半角英数字または制御コードでない場合にはＪＩＳに変換して上記のIsJISKanjiLevel2関数に通すというものです。

Public Function IsUniKanjiLevel2(ByVal strUni As String) As Boolean
    Dim i As Long
    Dim ch As String
    Dim Code As Long
    Dim targetBytes() As Byte
    
    IsUniKanjiLevel2 = True
    
    For i = 1 To Len(strUni)
        ch = Mid(strUni, i, 1)
        Code = Asc(ch)
        If Code < 0 Or &H7F < Code Then
            targetBytes = ADODB_Encode_JIS(ch)
            If IsJISKanjiLevel2(targetBytes) = False Then
                IsUniKanjiLevel2 = False
                Exit For
            End If
        End If
    Next
End Function

　上記関数をテストするサブルーチン testJISX0208 を書いてみました。とりあえず動いているようです。

Sub testJISX0208()
    Dim msg As String
    If IsUniKanjiLevel2("髙") = True Then
        msg = "JISX0208"
    Else
        msg = "-"
    End If
    MsgBox (msg & ":" & "髙")

    If IsUniKanjiLevel2("愛") = True Then
        msg = "JISX0208"
    Else
        msg = "-"
    End If
    MsgBox (msg & ":" & "愛")
End Sub

（８月２４日追記）
実際にワード文書をチェックさせて、エラーが発生したらコメントで警告するようにしました。
１７ページの公報サンプルを１０秒以内でチェックしていますので、特段の高速化は不要とおもいます。