連続でたくさんのバーコードを作成する
以前にJavascriptでバーコードを作成するツールを紹介しましたが、仕事でたくさんのバーコードを連続で作成する必要がありました。
AccessはメンテナンスがしにくいためExcelで作成することにしたのですが(単に私が苦手なだけかもしれませんが)、Excelに搭載されているActiveX BarCodeControlで
作成したバーコードが全然読み込めない問題が生じました。
ActiveX BarCodeControlで作成したバーコードがきちんと読み込めるかはサポート対象外とのことです…。
また、どういうわけかPCの設定によってはActiveXが使用できず、バーコード作成自体出来ない場合もありました。
そこで今回はExcelVBAの標準の機能のみでバーコードを連続作成するツールを考えてみました。
JANのバーコードの仕様について
バーコード作成のための法則はこちらのサイトを参考にしています。
詳しい説明は省略しますが、JANのバーコードは大まかに下記の法則で作成されています。
スポンサーリンク
バーコード作成の仕様・出来上がりイメージについて
今回はとりあえずJANコード一覧の隣にバーコードが作成できればOKなので、セルを直接使って色の塗りつぶしでバーコードを表示させることにしました。
A列に記入したJANコードのバーコードをM~DC列(95列:12文字×7+3(開始)+5(センター)+3(終了))に表示させるコードを考えます。
念のためL列とDD列はスペースとして用意しています。
また今回は標準の13桁のコードのみを作成することにしています。
短縮8桁コードはまた時間のある時に作成します。
バーコードを作成するExcelVBAコードについて
191019追記:こちらの記事で改良したExcelVBAコードを紹介しています。
私が今回作成したExcelVBAコードは下記の通りです。
最初の1桁から組み合わせを確認するのが若干面倒ですが、1度作ってしまえば簡単な仕組みです。
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などに貼り付けできるのが目標です。
コメント