エクセルVBAでJANコードからバーコードをまとめて生成する

冒頭まとめ

• JANコード一覧を渡されて大量のバーコードを作る仕事が出てきた
• Accessが入ってないので「Microsoft BarCode Control」は使えない
• VBA先輩で解決
• セキュリティ的に問題は無いので、VBAのコードをそのまま載せます

⚠注意事項

今回制作したものは13桁の標準JANコード用の文字列→バーコード画像変換マクロです。
8桁の短縮JANコードやその他の種類のバーコードの生成には対応しておりませんのでご容赦ください。

また、本マクロの利用に伴うトラブルに関しては原則責任は負いかねますのでご了承ください。

手っ取り早くバーコードを作りたい人向け

バーコードを作りたいJANコードが入ったエクセルファイルからVisual Basic Editorを開き、以下のコードをお好きな場所に追加してください。

A列にJANコードが並んだシートを選択した状態でこのマクロを実行すると、B列に各バーコード画像が生成されます。

Before

After

Visual Basic Editorを使ったマクロの追加方法が分からない方はこの辺りの記事を参照してください。

CreateManyBarCodes

Sub CreateManyBarCodes()
    Dim i As Integer
    Dim count_rows As Integer
    
    ' 処理するJANコード数をカウント
    count_rows = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ' 処理回数だけ予め行の幅を変更
    For i = 2 To count_rows
        ActiveSheet.Rows(i).RowHeight = 77
    Next i
    ActiveSheet.Columns("B").ColumnWidth = 22
    
    ' デフォルト（数字の列がある）のシートの名前を格納
    Dim defaultSheet As Worksheet
    Dim defaultSheetName As String
    defaultSheetName = ActiveSheet.Name
    Set defaultSheet = Worksheets(defaultSheetName)
    
    
    ' BarCodeStudioシートを作成。すでにあればスキップ
    Dim ws As Worksheet, flag As Boolean
    Dim BarCodeStudio As Worksheet
    For Each ws In Worksheets
        If ws.Name = "BarCodeStudio" Then flag = True
    Next ws
    If flag = False Then
        Set BarCodeStudio = Worksheets.Add
        BarCodeStudio.Name = "BarCodeStudio"
    Else
        Set BarCodeStudio = Worksheets("BarCodeStudio")
    End If
    ' カラムの幅を調整
    BarCodeStudio.Columns("A").ColumnWidth = 20
    BarCodeStudio.Rows(1).RowHeight = 75
    BarCodeStudio.Range("A1").Borders.Color = RGB(255, 255, 255)
    
    
    ' バーコード作成ループ
    Dim janCode As String
    Dim j As Integer
    Dim errorChoice As Variant
    Dim finalCode As String
    Dim combi As String
    Dim janCode_arr(13) As Variant
    Dim n As Integer
    Dim barColor As Variant
    Dim barLong As Integer: barLong = 50
    Dim nx As Integer
    Dim cht As Chart
    
    For i = 2 To count_rows
        BarCodeStudio.Activate
        ActiveSheet.Shapes.SelectAll
        Selection.Delete
        
        janCode = defaultSheet.Cells(i, "A").Text
        
        ' 数字以外が入っていた場合の処理
        If Len(janCode) < 13 Then
            GoTo Continue
        End If
        j = 1
        For n = 1 To Len(janCode)
            If Mid(janCode, n, 1) Like "[0-9.]" Then
                janCode_arr(j - 1) = Mid(janCode, n, 1)
                j = j + 1
            End If
            Debug.Print janCode_arr(j - 1)
        Next n
        Debug.Print janCode
        
        ' JANコードを符号化する
        ' マージン 11モジュール
        Dim MARGIN_11 As String: MARGIN_11 = "00000000000"
        ' マージン 7モジュール
        Dim MARGIN_7 As String: MARGIN_7 = "0000000"
        ' レフト/ライトガードバー
        Dim LR_GUARD As String: LR_GUARD = "101"
        ' センターガードバー
        Dim CENTER_GUARD As String: CENTER_GUARD = "01010"
        ' レフトデータバー(奇数パリティ)
        Dim LEFT_DATA_CHAR_ODD(10) As String
            LEFT_DATA_CHAR_ODD(0) = "0001101"
            LEFT_DATA_CHAR_ODD(1) = "0011001"
            LEFT_DATA_CHAR_ODD(2) = "0010011"
            LEFT_DATA_CHAR_ODD(3) = "0111101"
            LEFT_DATA_CHAR_ODD(4) = "0100011"
            LEFT_DATA_CHAR_ODD(5) = "0110001"
            LEFT_DATA_CHAR_ODD(6) = "0101111"
            LEFT_DATA_CHAR_ODD(7) = "0111011"
            LEFT_DATA_CHAR_ODD(8) = "0110111"
            LEFT_DATA_CHAR_ODD(9) = "0001011"
        ' レフトデータバー(偶数パリティ)
        Dim LEFT_DATA_CHAR_EVEN(10) As String
            LEFT_DATA_CHAR_EVEN(0) = "0100111"
            LEFT_DATA_CHAR_EVEN(1) = "0110011"
            LEFT_DATA_CHAR_EVEN(2) = "0011011"
            LEFT_DATA_CHAR_EVEN(3) = "0100001"
            LEFT_DATA_CHAR_EVEN(4) = "0011101"
            LEFT_DATA_CHAR_EVEN(5) = "0111001"
            LEFT_DATA_CHAR_EVEN(6) = "0000101"
            LEFT_DATA_CHAR_EVEN(7) = "0010001"
            LEFT_DATA_CHAR_EVEN(8) = "0001001"
            LEFT_DATA_CHAR_EVEN(9) = "0010111"
        ' ライトデータバー、チェックディジットバー
        Dim RIGHT_DATA_CHAR(10) As String
            RIGHT_DATA_CHAR(0) = "1110010"
            RIGHT_DATA_CHAR(1) = "1100110"
            RIGHT_DATA_CHAR(2) = "1101100"
            RIGHT_DATA_CHAR(3) = "1000010"
            RIGHT_DATA_CHAR(4) = "1011100"
            RIGHT_DATA_CHAR(5) = "1001110"
            RIGHT_DATA_CHAR(6) = "1010000"
            RIGHT_DATA_CHAR(7) = "1000100"
            RIGHT_DATA_CHAR(8) = "1001000"
            RIGHT_DATA_CHAR(9) = "1110100"
        ' レフトデータバーの組み合わせ
        '  0:   奇数パリティ
        '  1:   偶数パリティ
        Dim COMBINATION(10) As String
            COMBINATION(0) = "000000" ' OOOOOO
            COMBINATION(1) = "001011" ' OOEOEE
            COMBINATION(2) = "001101" ' OOEEOE
            COMBINATION(3) = "001110" ' OOEEEO
            COMBINATION(4) = "010011" ' OEOOEE
            COMBINATION(5) = "011001" ' OEEOOE
            COMBINATION(6) = "011100" ' OEEEOO
            COMBINATION(7) = "010110" ' OEOEEO
            COMBINATION(8) = "010110" ' OEOEEO
            COMBINATION(9) = "011010" ' OEEOEO
            
        finalCode = finalCode + MARGIN_11 + LR_GUARD
        'レフトデータバーを符号化
        combi = COMBINATION(janCode_arr(0))
        For n = 2 To 7
            If Mid(combi, n - 1, 1) = "0" Then
                finalCode = finalCode + LEFT_DATA_CHAR_ODD(CInt(janCode_arr(n - 1)))
            Else
                finalCode = finalCode + LEFT_DATA_CHAR_EVEN(CInt(janCode_arr(n - 1)))
            End If
        Next n
        ' センターガードバー
        finalCode = finalCode + CENTER_GUARD
        ' ライトデータバーを符号化
        For n = 8 To 13
            finalCode = finalCode + RIGHT_DATA_CHAR(CInt(janCode_arr(n - 1)))
        Next n
        ' ライトガードバーとマージン
        finalCode = finalCode + LR_GUARD + MARGIN_7
        Debug.Print finalCode
        
        
        ' 符号化したコードをバーに出力
        For n = 1 To Len(finalCode)
            If Mid(finalCode, n, 1) = "0" Then
                barColor = vbWhite
            ElseIf Mid(finalCode, n, 1) = "1" Then
                barColor = vbBlack
            End If
            ' テスト用
            ' With BarCodeStudio.Shapes.AddLine(n, 25 + (i - 1) * 100, n, 75 + (i - 1) * 100).Line
            barLong = 50
            If n <= 14 Or n >= 104 Then
                barLong = 50
            ElseIf n >= 57 And n <= 61 Then
                barLong = 50
            ElseIf n >= 15 And n <= 56 Then
                barLong = 40
            ElseIf n >= 62 And n <= 103 Then
                barLong = 40
            End If
            With BarCodeStudio.Shapes.AddLine(2 + n, 15, 2 + n, 15 + barLong).Line
                .ForeColor.RGB = barColor
                .Weight = 1.1
            End With
        Next n
        
        
        ' 目視数字を作成
        For n = 1 To Len(janCode) - 1
            ' X座標を調整
            If n = 1 Then
                nx = 1 + n * 7
            ElseIf n >= 2 And n <= 7 Then
                nx = 4 + n * 7
            ElseIf n >= 8 And n <= 13 Then
                nx = 8 + n * 7
            End If
            With BarCodeStudio.Shapes.AddShape(msoShapeRectangle, nx, 55, 6, 10)
                With .Fill
                    .ForeColor.RGB = vbBlack
                    .Visible = msoFalse
                End With
                With .TextFrame
                    With .Characters
                        .Text = janCode_arr(n - 1)
                        .Font.Name = "Calibri"
                        .Font.Size = 9
                        .Font.Color = vbBlack
                    End With
                    .MarginBottom = 0
                    .MarginLeft = 0
                    .MarginRight = 0
                    .MarginTop = 0
                End With
                With .Line
                    .Visible = msoFalse
                End With
            End With
            
        Next n
        
        ' 画像化してJANコードの横にペーストする
        BarCodeStudio.Range("A1").CopyPicture _
             Appearance:=xlPrinter, Format:=xlPicture  ' AppearanceはxlPrinter推奨
        Application.Wait [Now()] + 50 / 86400000  'ミリ秒単位で停止時間を指定
        defaultSheet.Cells(i, "B").PasteSpecial
        
        ' finalCodeを初期化
        finalCode = ""
Continue:
    Next i
    ' バーコード出力ループ終了
    
End Sub

やったこと

JANコードの仕様調査

そもそもJANコードの規格を知らなかったため、以下の記事を参考にしました。
なかなか面白い仕様だと知ることができ時間をかけた甲斐がありました。

特に２つ目の @Dolphin_0809 様の記事が無ければ膨大に時間が掛かっていたと思います。
この場を借りて御礼申し上げます。

VBAの特殊操作の学習

VBAでオブジェクトを操作したり画像を生成する手段については、この辺りの記事の数々に助けられました。
ありがとうございます。

おおざっぱなコード解説

1. A列2行目以下にJANコードが入ったエクセルシートを用意。
2. A列の行数から処理をおこなう回数（＝JANコード数）をカウント。
3. バーコード組立て用のシートを新規作成
4. バーコード生成のForループ開始
5. 13桁のJANコードを0/1からなる文字列に変換
6. 0/1からなる文字列を元に、幅1px高さ40～50pxの線オブジェクトを作成（0：白色の線、1：黒色の線）
7. 目視文字（バーの下に付いてるアラビア数字）をテキストボックスオブジェクトにて配置
8. ここまででバーコードが１つ完成
9. 作成したバーコードをCopyPictureでbmp画像化し、JANコードが一覧になっていたシートのB列にペースト
10. 以上をJANコードの数だけループして完了

余談

このマクロが一回完成した後、マクロ有効ブックとして保存したのに、翌日開くとなぜかマクロがすべて消えていました。

エクセル初期設定君、絶対に許さない（保存方法には注意しましょう）