ISBN番号入力チェックマクロ(VBA)

Const ISBN_FLAG As String = "978" '2007年以降導入される予定の13桁ISBNコードで使用されるフラグ。

 
'2007年以降導入される予定の13桁ISBNコード

Public Function ISBNCheck2007(ranran As Range) As Integer
'http://www.isbn-center.jp/whatsnew/kikaku.html

'【参照(1)】13桁ＩＳＢＮのチェックデジットの計算方法（書籍ＪＡＮの計算式に同じ）

'　  （13桁コードの左から奇数桁の数字の合計×１）と（偶数桁の数字の合計×３)の合計を求める。

'     次に10−（求めた合計の下１桁の数字）＝チェック数字。ただし、求めた下１桁が０の場合はチェック数字を０とする。

'＜計算事例＞

'　             フラグ　  　国　  　出版者記号　  　書名記号　    　チェック数字

'       ＩＳＢＮ    978 4   949999  08  ?

'        奇数桁合計×１  　　9＋8＋9＋9＋9＋0＝44　44×１＝44

'        偶数桁合計×３  　　7＋4＋4＋9＋9＋8＝41　41×３＝123

'    　　44＋123＝167　　　10−7＝3
    Dim isbnnumbers As String

    Dim checksum As Integer

    Dim checkdigit As Integer

    

    If ranran.count <> 0 Then

        ISBNCheck2007 = 0

    End If

    

    isbnnumbers = ranran.text

        

    isbnnumbers = StrConv(isbnnumbers, vbNarrow)    '半角変換

    isbnnumbers = StrConv(isbnnumbers, vbLowerCase) '小文字変換
    isbnnumbers = Replace(isbnnumbers, "isbn", "")

    isbnnumbers = Replace(isbnnumbers, "-", "")
    isbnnumbers = ISBN_FLAG & isbnnumbers

    isbnnumbers = Left(isbnnumbers, Len(isbnnumbers))
    Dim i As Integer
    For i = 1 To Len(isbnnumbers) - 1

    

        If i Mod 2 = 0 Then

           checksum = checksum + Mid(isbnnumbers, i, 1) * 3

           

        Else

           checksum = checksum + Mid(isbnnumbers, i, 1) * 1

        End If

    Next i

    

    If CStr((10 - Right(CStr(checksum), 1))) = Right(isbnnumbers, 1) Then

        checkdigit = 1

    Else

        checkdigit = 0

    End If

    

    ISBNCheck2007 = checkdigit

    

End Function
Public Function ISBNCheck(targetCell As Range) As Integer

    'ISBNの整合性をチェックする。OKなら１、NGなら0を返す。

    'SEE　ALSO:http://www.tulips.tsukuba.ac.jp/misc/export/cat/isbn.html

    '桁数チェック未対応

    

    Dim isbnnumbers As String

    Dim checksum As Integer
    isbnnumbers = targetCell.text

    isbnnumbers = StrConv(isbnnumbers, vbNarrow)    '半角変換

    isbnnumbers = StrConv(isbnnumbers, vbLowerCase) '小文字変換

    isbnnumbers = Replace(isbnnumbers, "isbn", "")  '"isbn"の文字を取り除く

    isbnnumbers = Replace(isbnnumbers, "-", "")

    isbnnumbers = Left(isbnnumbers, Len(isbnnumbers))
    Dim i As Integer

    

    On Error GoTo errhandler:

    

    Dim weight As Integer  '各桁のウエイト

    weight = 10

    

    For i = 1 To Len(isbnnumbers) - 1

           checksum = checksum + Mid(isbnnumbers, i, 1) * weight

            weight = weight - 1

    Next i

    

    Dim checkdigit As Integer

    

    checkdigit = checksum Mod 11

    checkdigitstring = CStr(11 - checkdigit)

    

    If checkdigitstring = "10" Then

        checkdigitstring = "X"

    End If

    

    

    If CStr(checkdigitstring) = Right(isbnnumbers, 1) Then

        ISBNCheck = 1

    Else

        ISBNCheck = 0

    End If

        

    Exit Function

    

errhandler:

        ISBNCheck = 0
End Function