三栄NAVIの中に、バーコードの話をいくつか記載しております。
バリアブル印刷をお受けしている中で、バーコードが含まれる事もあります。

バーコードが可変の場合、色々な対応方法が考えられますが。
最終的には、文字フォントで対応するのが一番良いと言う事となります。

そんな流れで、バーコードフォントを自作した事がありました。

このNAVIの中でも、自作のバーコードフォントを公開しているものもあります。

自作フォントが、世の中で使用されているのか全く分かりませんでした。

昨日、このバーコードで問い合わせが入りました。
ＪＡＮコードに対する物でした。

作成してから、大分経っており、即答できず、三栄NAVIを再確認！

先ほども述べましたが、そもそも、フォントを作ったのは、バリアブル印刷対応から、必要に攻められて作成した経緯があります。
しかし、問い合わせの有った、JANコードは、商品コードであり、その性質上バリアブル印刷で出てくる事は、まず無いでしょう。

その当時、パンフやシールなどの印刷依頼の中で、JANコードを扱う事がありました。
入稿される画像データに問題が多く、版下を綺麗にすると言う流れの中で、作ったように記憶してます。

JANコードは、数字１３桁の商品コードですが、数字から実際のバーコードに変換するには、ルールに沿った変換を行う必要があります。
NAVIの記事の中では、エクセルのＶＢＡで変換プログラムも合わせて紹介していました。

・・・・・大分思い出しました。

改めて、紹介しているエクセルファイルを見ましたが、シート上に、ボタンを配置したものです。
ボタンでスクリプトを起動してＪＡＮコードを生成します。
今、考えて見ると、使い勝手の悪い形で紹介していたようです。

スクリプトを２～３行、書き直して関数化しました。

これにより、ユーザ定義関数として使用可能です。

フォントと合わせてダウンロード出来るようにしました。

自分の作ったものが、使用されるってうれしいものですね！

 エクセル・フォントダウンロード　⇒　ここから

 なお、関数のVBA記述は、下記コードを参照してください。

Function JANHENKAN(CODE)

    'JANコード読み取り
    JAN_No = CODE
    If Len(JAN_No) = 12 Then
    Rem　モジュラス10/ウェイト3　のチェックデジットの計算
    Rem　１３桁の場合は、チェックデジットが含まれているとして、そのまま使用します。

        OD = 0
        EV = 0

        For a = 1 To 12 Step 1
            ChdCar = Mid(JAN_No, a, 1)
            If (a Mod 2) = 0 Then
                OD = OD + ChdCar
            Else
                EV = EV + ChdCar
            End If
    
            ChdCaA = EV + (OD * 3)
        Next

        ChdCarMoto = CInt(Right(Str(ChdCaA), 1))
        ChdCarMot = 1000 - CInt(Right(Str(ChdCarMoto), 1))
        ChdCarCODE = Right(Str(ChdCarMot), 1)

        JAN_No = JAN_No & ChdCarCODE

    Rem ===============================================
    End If

    F1stcar = Left(JAN_No, 1)
    mojityy = "000000"

        Select Case F1stcar
            Case "0"
               mojityy = "000000"
            Case "1"
               mojityy = "001011"
            Case "2"
               mojityy = "001101"
            Case "3"
               mojityy = "001110"
            Case "4"
               mojityy = "010011"
            Case "5"
               mojityy = "011001"
            Case "6"
               mojityy = "011100"
            Case "7"
               mojityy = "010101"
            Case "8"
               mojityy = "010110"
            Case "9"
               mojityy = "011010"
        End Select

    'スタートキャラ
    seikeiData = "("

    For a = 2 To 13 Step 1
        ChdCar = Mid(JAN_No, a, 1)
        If a <= 7 Then
            If Mid(mojityy, a - 1, 1) = "0" Then
                'seikeiData = seikeiData & ChdCar
            Else
                ChdCar = Replace(ChdCar, "0", "A")
                ChdCar = Replace(ChdCar, "1", "B")
                ChdCar = Replace(ChdCar, "2", "C")
                ChdCar = Replace(ChdCar, "3", "D")
                ChdCar = Replace(ChdCar, "4", "E")
                ChdCar = Replace(ChdCar, "5", "F")
                ChdCar = Replace(ChdCar, "6", "G")
                ChdCar = Replace(ChdCar, "7", "H")
                ChdCar = Replace(ChdCar, "8", "I")
                ChdCar = Replace(ChdCar, "9", "J")
            End If
        
            seikeiData = seikeiData & ChdCar
        Else
            If a = 8 Then
                seikeiData = seikeiData & "X"
            End If
    
            ChdCar = Replace(ChdCar, "0", "K")
            ChdCar = Replace(ChdCar, "1", "L")
            ChdCar = Replace(ChdCar, "2", "M")
            ChdCar = Replace(ChdCar, "3", "N")
            ChdCar = Replace(ChdCar, "4", "O")
            ChdCar = Replace(ChdCar, "5", "P")
            ChdCar = Replace(ChdCar, "6", "Q")
            ChdCar = Replace(ChdCar, "7", "R")
            ChdCar = Replace(ChdCar, "8", "S")
            ChdCar = Replace(ChdCar, "9", "T")
            seikeiData = seikeiData & ChdCar
        End If
    Next
            seikeiData = seikeiData & ")"
            JANHENKAN = seikeiData

End Function