JANコードのチェックデジット計算

Option Compare Database
Option Explicit

Private Sub コマンド0_Click()

    Dim rt

    rt = Calc_CD("490112163009")

    Debug.Print rt  '結果 = 0

End Sub

'------------------------------------------------------
' 機能　：JANコードのチェックデジット計算
'
' 引数  ：  jancode (String)   JANコード 12桁 or 7桁
'
' 戻値  ：　チェックデジット
'
'------------------------------------------------------
Function Calc_CD(jancode) As String

    Dim lng         As Long     '引数の長さ
    Dim even_sum    As Long     '偶数合計
    Dim odd_sum     As Long     '奇数合計
    Dim wk_even     As Long
    Dim wk_sum      As Long
    Dim wk_cd       As Long
    Dim i           As Long

    lng = Len(jancode)

    If Not (lng = 7 Or lng = 12) Then
        Calc_CD = "引数エラー"
        Exit Function
    End If
   
    '------------------------------------------------------------
    ' JAN 桁位置
    '------------------------------------------------------------
    ' JANメーカーコード ：  13 〜 5　   までの9桁
    ' アイテムコード    ：  4〜2        までの3桁
    ' CD                ：  1           の1桁
    
    '-----------+----+----+----+----+----+----+----+----+----+----+----+----+---+
    ' 桁        | 13 | 12 | 11 | 10 | 9  | 8  | 7  | 6  | 5  | 4  | 3  | 2  | 1 |
    '-----------+----+----+----+----+----+----+----+----+----+----+----+----+---+
    '偶数位置   |    | ○ |    | ○ |    | ○ |    | ○ |    | ○ |    | ○ |   |
    '-----------+----+----+----+----+----+----+----+----+----+----+----+----+---+
    '奇数位置   | ○ |    | ○ |    | ○ |    | ○ |    | ○ |    | ○ |    |   |
    '-----------+----+----+----+----+----+----+----+----+----+----+----+----+---+

    jancode = "0" & StrReverse(jancode) '桁位置あわせ

    '------------------------------------------------
    ' JAN CD計算方法
    '------------------------------------------------
    '�@ |   すべての偶数位置の数字を加算
    '�A |   すべての奇数位置の数字を加算
    '�B |   �@を3倍
    '�C |   �Aと�Bを加算
    '�D |   �Cの下1桁の数字を10から引く
    '�E |   �Dの結果が10の場合は0
    '------------------------------------------------

    For i = 1 To Len(jancode)
        If (i Mod 2) = 0 Then
            even_sum = even_sum + CLng(Mid(jancode, i, 1))  '�@
        Else
            odd_sum = odd_sum + CLng(Mid(jancode, i, 1))    '�A
        End If
    Next i

    wk_even = even_sum * 3          '�B
    
    wk_sum = wk_even + odd_sum      '�C
        
    wk_cd = 10 - Right(wk_sum, 1)   '�D

    wk_cd = Right(wk_cd, 1)         '�E

    Calc_CD = wk_cd

End Function