開発のヒント

チェックデジットを計算する関数

Access Tips [VBA自作関数]

概要説明

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

  • チェックデジットを生成したい
  • 13桁または7桁のJANコードが正しいか判定したい
  • ※JANコード(13桁または7桁)を対象としており、それ以外のバーコードには対応していません。
  • ※Excel VBAでも使用できます。
関数
'--------------------------------------------------
' JANコードのチェックデジットを計算する関数
'--------------------------------------------------
Public Function Calc_Check_Digit(strCheck_Digit_Value As String) 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
    
    With Me
        strValue = Calc_Check_Digit(.テキスト1.Value)
        .テキスト2.Value = strValue
        .テキスト3.Value = .テキスト1.Value & strValue
    End With

Exit_コマンド0_Click:
    Exit Sub

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

[動作確認]
①テキストボックス(チェックデジットを生成前の12桁か7桁のJANコード)に数字を入力します。
(ここでは490000011111)

②「チェックデジット生成」ボタンをクリックするとチェックデジットが生成され、
 テキストボックスに表示されます。

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

例として以下のようなフォームを作成します。

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

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

[動作確認]
①テキストボックス(入力したJANコード)に数字を入力します。
(ここでは4911111000001)

②「チェックデジット正誤判定」ボタンをクリックすると、入力したJANコードの下1桁以外から
 生成されたチェックデジットがテキストボックスに表示されます。