ExcelVBAでJAN一覧表からバーコードを作成する

2019.10.13
スポンサーリンク

連続でたくさんのバーコードを作成する

以前にJavascriptでバーコードを作成するツールを紹介しましたが、仕事でたくさんのバーコードを連続で作成する必要がありました。

AccessはメンテナンスがしにくいためExcelで作成することにしたのですが（単に私が苦手なだけかもしれませんが）、Excelに搭載されているActiveX BarCodeControlで
作成したバーコードが全然読み込めない問題が生じました。
ActiveX BarCodeControlで作成したバーコードがきちんと読み込めるかはサポート対象外とのことです…。

また、どういうわけかPCの設定によってはActiveXが使用できず、バーコード作成自体出来ない場合もありました。

そこで今回はExcelVBAの標準の機能のみでバーコードを連続作成するツールを考えてみました。

JANのバーコードの仕様について

バーコード作成のための法則はこちらのサイトを参考にしています。

詳しい説明は省略しますが、JANのバーコードは大まかに下記の法則で作成されています。

  • ①1つの数字について7つのバーの組み合わせで表示されます。「0010011」など
  • ②バーコードの開始位置・真ん中・終了位置には専用のコード「101」・「01010」・「101」が含まれます。
  • ③バーコードに含まれている情報は先頭の数字を除く数字12桁分です。
  • ④開始位置から真ん中までの6桁はそれぞれ1つの数字につき2種類ずつ存在し（奇数パリティ・偶数パリティ）、その組み合わせによって先頭の数字を決定します。

    • スポンサーリンク

    バーコード作成の仕様・出来上がりイメージについて

    今回はとりあえずJANコード一覧の隣にバーコードが作成できればOKなので、セルを直接使って色の塗りつぶしでバーコードを表示させることにしました。
    A列に記入したJANコードのバーコードをM～DC列（95列：12文字×7+3（開始）+5（センター）+3（終了））に表示させるコードを考えます。
    念のためL列とDD列はスペースとして用意しています。

    また今回は標準の13桁のコードのみを作成することにしています。
    短縮8桁コードはまた時間のある時に作成します。

    バーコードを作成するExcelVBAコードについて

    191019追記：こちらの記事で改良したExcelVBAコードを紹介しています。

    私が今回作成したExcelVBAコードは下記の通りです。
    最初の1桁から組み合わせを確認するのが若干面倒ですが、1度作ってしまえば簡単な仕組みです。

    Sub バーコード作成13桁のみ()

    Dim パリティ
    Dim 左コード
    Dim 右コード
    Dim コード
    Dim i, k

    ’ガイド線を消す（消さないとバーコード読めない）
    ActiveWindow.DisplayGridlines = False

    ’L～DD列の色を消して幅をそろえる
    Range(Cells(1, 12), Cells(Rows.Count, 108)).Interior.ColorIndex = xlNone
    Range(Columns(12), Columns(108)).ColumnWidth = 0.13

    ’JANコードが記載されているところは継続処理
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

    If Len(Cells(i, 1)) = 13 Then

    ’最初の1文字目からパリティを算出
    Select Case Left(Cells(i, 1), 1)
    Case “0”
    パリティ = Array(“奇数”, “奇数”, “奇数”, “奇数”, “奇数”, “奇数”)
    Case “1”
    パリティ = Array(“奇数”, “奇数”, “偶数”, “奇数”, “偶数”, “偶数”)
    Case “2”
    パリティ = Array(“奇数”, “奇数”, “偶数”, “偶数”, “奇数”, “偶数”)
    Case “3”
    パリティ = Array(“奇数”, “奇数”, “偶数”, “偶数”, “偶数”, “奇数”)
    Case “4”
    パリティ = Array(“奇数”, “偶数”, “奇数”, “奇数”, “偶数”, “偶数”)
    Case “5”
    パリティ = Array(“奇数”, “偶数”, “偶数”, “奇数”, “奇数”, “偶数”)
    Case “6”
    パリティ = Array(“奇数”, “偶数”, “偶数”, “偶数”, “奇数”, “奇数”)
    Case “7”
    パリティ = Array(“奇数”, “偶数”, “奇数”, “偶数”, “奇数”, “偶数”)
    Case “8”
    パリティ = Array(“奇数”, “偶数”, “奇数”, “偶数”, “偶数”, “奇数”)
    Case “9”
    パリティ = Array(“奇数”, “偶数”, “偶数”, “奇数”, “偶数”, “奇数”)
    End Select

    コード = “101” ’左ガードバー
    For x = 2 To 7
    If パリティ(x － 2) = “奇数” Then
    左コード = Array(“0001101”, “0011001”, “0010011”, “0111101”, “0100011”, “0110001”, “0101111”, “0111011”, “0110111”, “0001011”)
    コード = コード & 左コード(Mid(Cells(i, 1), x, 1))
    ElseIf パリティ(x － 2) = “偶数” Then
    左コード = Array(“0100111”, “0110011”, “0011011”, “0100001”, “0011101”, “0111001”, “0000101”, “0010001”, “0001001”, “0010111”)
    コード = コード & 左コード(Mid(Cells(i, 1), x, 1))
    End If
    Next x
    コード = コード & “01010” ’センターバー

    For x = 8 To 13
    右コード = Array(“1110010”, “1100110”, “1101100”, “1000010”, “1011100”, “1001110”, “1010000”, “1000100”, “1001000”, “1110100”)
    コード = コード & 右コード(Mid(Cells(i, 1), x, 1))
    Next x

    コード = コード & “101” ’右ガードバー

    For x = 13 To 107 ’変換したコードで色を塗り分ける
    If Mid(コード, x － 12, 1) = “1” Then
    Cells(i, x).Interior.Color = RGB(0, 0, 0)
    ElseIf Mid(コード, x － 12, 1) = “0” Then
    Cells(i, x).Interior.Color = RGB(255, 255, 255)
    End If
    Next x

    ’初期化
    Erase パリティ
    Erase 右コード
    Erase 左コード
    コード = “”

    End If
    Next i

    End Sub

    今後の改良について

    今後の改良の予定ですが、短縮の8桁コードについては今後作成できるようにまた作ります。
    （191019追記：こちらの記事で改良したコードを公開しています。）

    あとは今回作成したバーコードはセル上に直接色付けして作成しているので動かしにくいので、画像オブジェクトとして貼り付けできるようにする方法も組み込みます。
    （191019追記：こちらの記事で画像オブジェクトとして貼り付ける方法を公開しています。）

    今回のバーコード作成は店舗などで使用するプライスカードの作成を想定しているものなので、PowerPointなどに貼り付けできるのが目標です。

    スポンサーリンク

    コメント