Access Tips ［VBA自作関数］

JANコードのチェックデジットを計算する関数

解説

この関数は以下のケースで利用できます。

   1. チェックデジットを生成したい
   2. 13桁または7桁のJANコードが正しいか判定したい

※JANコード（13桁または7桁）を対象としており、それ以外のバーコードには対応していません。
チェックデジットとは

内容

以下の関数を標準モジュールに貼り付けて下さい。 （ 標準モジュールとは）

'--------------------------------------------------
' JANコードのチェックデジットを計算する関数
'--------------------------------------------------
Public Function Calc_Check_Digit(strCheck_Digit_Value) As String

    Dim intValue(12)            As Integer      '値を1桁ずつ格納する配列
    Dim i                       As Integer
    Dim intEven                 As Integer      '偶数
    Dim intOdds                 As Integer      '奇数
    Dim strValue_13             As String       '13桁のJANコード
    
    '12桁及び7桁の場合、左を0詰めして12桁にした上で最後に0を付加。
    If Len(strCheck_Digit_Value) = 12 Or Len(strCheck_Digit_Value) = 7 Then
        strValue_13 = Format(strCheck_Digit_Value, "000000000000") & "0"
        
    '8桁の場合、左を0詰めして13桁にする。
    ElseIf Len(strCheck_Digit_Value) = 8 Then
        strValue_13 = Format(strCheck_Digit_Value, "0000000000000")
        
    '13桁の場合はそのまま。
    Else
        strValue_13 = strCheck_Digit_Value
        
    End If
    
    
    intEven = 0
    intOdds = 0
    
    '右から2番目から13番目の値について、偶数位置、奇数位置の値をそれぞれ足していく。
    For i = 2 To Len(strValue_13)
        
        If (i Mod 2) <> 0 Then
            intOdds = intOdds + CInt(Mid(strValue_13, 14 - i, 1))
        Else
            intEven = intEven + CInt(Mid(strValue_13, 14 - i, 1))
        End If
    
    Next i
    
    '偶数位置の合計を3倍する
    intEven = intEven * 3
    
    '偶数位置の合計の3倍の値と奇数位置の合計の値を足し、
    '1の位の値が0の場合は0を返す。その他の場合は10から1の位の値を引いた値を返す。
    If CInt(Right(intEven + intOdds, 1)) = 0 Then
        Calc_Check_Digit = "0"
    Else
        Calc_Check_Digit = CStr(10 - CInt(Right(intEven + intOdds, 1)))
    End If
    
End Function

チェックデジットの生成

以下のフォームを作成し、ボタンのクリックイベントに下記のコードを貼り付けます。



'----------------------------------------------------------------------
' 「チェックデジット生成」ボタンクリックイベントのコード
'----------------------------------------------------------------------
Private Sub コマンド0_Click()
On Error GoTo Err_コマンド0_Click

    Dim strValue            As String
    
    strValue = Calc_Check_Digit(Me.テキスト1.Value)

    Me.テキスト2.Value = strValue
    
    Me.テキスト3.Value = Me.テキスト1.Value &amp; strValue

Exit_コマンド0_Click:
    Exit Sub

Err_コマンド0_Click:
    MsgBox Err.Description
    Resume Exit_コマンド0_Click
    
End Sub
'----------------------------------------------------------------------

[動作確認]
①テキストボックス(チェックデジットを生成前の12桁か7桁のJANコード)に数字を入力します。
（ここでは490000011111）
②「チェックデジット生成」ボタンをクリックするとチェックデジットが生成され、
　テキストボックスに表示されます。

チェックデジットの正誤判定

以下のフォームを作成し、ボタンのクリックイベントに下記のコードを貼り付けます。
<img src="./images/tips_page/jan_checkdigit_check.jpg" border="0" />


'----------------------------------------------------------------------
' 「チェックデジット正誤判定」ボタンクリックイベントのコード
'----------------------------------------------------------------------
Private Sub コマンド0_Click()
On Error GoTo Err_コマンド0_Click
    
        
    Me.テキスト2.Value = Right(Me.テキスト1.Value, 1)
    
    Me.テキスト3.Value = Calc_Check_Digit(Me.テキスト1.Value)
        

Exit_コマンド0_Click:
    Exit Sub

Err_コマンド0_Click:
    MsgBox Err.Description
    Resume Exit_コマンド0_Click
    
End Sub
'----------------------------------------------------------------------

[動作確認]
①テキストボックス(入力したJANコード)に数字を入力します。
（ここでは4911111000001）
②「チェックデジット正誤判定」ボタンをクリックすると、入力したJANコードの下1桁以外から
　生成されたチェックデジットがテキストボックスに表示されます。
<img src="./images/tips_page/jan_checkdigit_check_res.jpg" />