Access Excel

バーコード帳票印刷(サンプル付き)

2020年7月24日

Accessによる簡易的な在庫管理システム関連です。
管理している品目にバーコードを付けてバーコードリーダで読み取らせたい場合もあるかと思います。
バーコードのフォントをインストールしなくても帳票を作れましたので、改訂しました。

自動管理システムのご依頼はATDシステムズへ

バーコード帳票印刷(サンプル付き)

サンプルダウンロード

DOWNLOAD 

バーコード帳票印刷(サンプル付き)
Excel2016にて作成しました。バーコードコントロールにはOfficeのバージョンによって違いがあるようで、Excel2013やExcel2019で動作するかどうかわかりません。報告があると嬉しいです。

なお、バーコードコントロールがデザインモードにしたり、ノーマルモードにしたりすると、見た目が変わります。「どうしてだろう?」と調べてみましたが、Offinceのバグのようです(こちら)。

使い方

サンプルを作りました。「マクロ有効化」のボタンを押して、自由に書き換えてご使用ください。

「登録済みデータ」というシートに仮データが入っております。これは上述の在庫管理システムより品目データをエクスポートした状態です。
帳票に使うのはA列~C列です。

「アドイン」という名のメニューに「帳票を初期化」「登録済みデータから帳票にコピー」「帳票を印刷」の3つの項目があります。
「帳票を初期化」は「帳票」シートをクリアします。
「登録済みデータから帳票にコピー」はA列~C列のデータを「帳票」シートへコピーし、印刷用に体裁を整えています。
「帳票を印刷」はプリンタに印刷しますが、動作確認をしておりません。「帳票」シートのI1セルに開始の品目コード(数値)を、I2セルにそこからいくつのデータを印刷するかを入力しておいて、「帳票を印刷」を実行します。

バーコード読み取りアプリ(Android)

バーコードやQRコードの読み取りには専用機器が必要になりそうですが、スマートフォンを利用する手もあります。Windowsのアプリケーションにてスマートフォンと連携します。詳しくは下記の作者のホームページを参照ください。

SHINOBI バーコードリーダーホームページ

Google Play で手に入れよう

VBA

This Workbookではメニュー設定のコードが書かれています。その他の実行コードは「Module1」に記載しています。

This WorkbookのVBAコード

'******************************************************************
'メニューバー設置
'******************************************************************
Private Sub Workbook_Open()
    Dim bar As CommandBar
    Dim menu As CommandBarControl
    Dim btn As CommandBarButton
    
    'Excelのメニューバーを指定
    Set bar = Application.CommandBars("Worksheet Menu Bar")

    'すでにコマンドバーにメニューがある場合は削除
    For Each menu In bar.Controls
        menu.Delete
    Next menu

    'コマンドバーにメニューを追加
    Set btn = bar.Controls.Add(Type:=msoControlButton)
    With btn
        .Style = msoButtonCaption
        .Caption = "帳票シートを初期化"
        .OnAction = "帳票初期化"
    End With
    
    Set btn = bar.Controls.Add(Type:=msoControlButton)
    With btn
        .Style = msoButtonCaption
        .Caption = "登録済みデータから帳票にコピー"
        .OnAction = "帳票にコピー"
    End With
    
    Set btn = bar.Controls.Add(Type:=msoControlButton)
    With btn
        .Style = msoButtonCaption
        .Caption = "帳票を印刷"
        .OnAction = "帳票を印刷"
    End With
End Sub

'******************************************************************
'Excelを閉じる前にメニューバーをクリアする
'******************************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim menu As CommandBarControl
    Dim bar As CommandBar
    
    Set bar = Application.CommandBars("Worksheet Menu Bar")
    For Each menu In bar.Controls
        menu.Delete
    Next menu
End Sub

Module1のVBAコード

Option Explicit

Const CellH = 42    '必要に応じて書き換えてください

'******************************************************************
'帳票シートの初期化
'******************************************************************
Sub 帳票初期化()
    With Worksheets("帳票")
        .Activate
        .Cells.Clear
        .Cells.RowHeight = CellH
        .Columns("B").NumberFormatLocal = "@"       '列B全体を文字列に
        .Columns("B").ShrinkToFit = True            'セルに収まるように (改行して表示なら WrapText = True)
        .Columns("B").HorizontalAlignment = xlCenter '中央寄せ
        .Columns("E").NumberFormatLocal = "@"
        .Columns("E").ShrinkToFit = True
        .Columns("E").HorizontalAlignment = xlCenter
    
        'シートからバーコードコントロールを削除する
        Dim shp As Shape
        For Each shp In .Shapes
            If shp.Type = msoOLEControlObject Then shp.Delete
        Next shp
        
        .Cells(1, "J") = "←印刷開始品目コード"
        .Cells(2, "J") = "←印刷する品目数"
    End With
End Sub

'******************************************************************
'登録済みデータから帳票シートにコピーする
'******************************************************************
Sub 帳票にコピー()
    '文字データ取得
    Dim lngRow As Long '登録済みデータの行
    Dim lngRow2 As Long '帳票の行
    Dim lngCol As Long '列
    Dim strCol As String
    Dim strCol2 As String
    Dim lng品目コード As Long
    Dim str品目 As String
    Dim strメーカー As String
    Dim strRng As String
    
    Worksheets("登録済みデータ").Activate
    lngRow = 2  '登録済みデータの行
    lngRow2 = 1 '帳票の行
        
    ' A列が空白になるまでループする
    Do While Worksheets("登録済みデータ").Cells(lngRow, "A") <> ""
        If lngRow Mod 2 = 0 Then
            lngCol = 2      '奇数ならB列
            strCol = "B"
            strCol2 = "A"
        Else
            lngCol = 5      '偶数ならE列
            strCol = "E"
            strCol2 = "D"
        End If
                
        With Worksheets("登録済みデータ")
            lng品目コード = .Cells(lngRow, "A")
            str品目 = .Cells(lngRow, "B")
            strメーカー = .Cells(lngRow, "C")
        End With
        
        With Worksheets("帳票")
            .Activate
            .Cells(lngRow2, lngCol) = lng品目コード
            .Cells(lngRow2, lngCol).Font.Size = 20
            .Cells(lngRow2, lngCol - 1) = "品目コード"
            .Cells(lngRow2 + 1, lngCol) = str品目
            .Cells(lngRow2 + 1, lngCol - 1) = "品目"
            .Cells(lngRow2 + 2, lngCol) = strメーカー
            .Cells(lngRow2 + 2, lngCol - 1) = "メーカー"
            Call Create_Barcode(lngRow2 + 3, strCol)
            .Cells(lngRow2 + 3, lngCol - 1) = "バーコード"
            
            ' 太枠で囲む
            Range(Replace(strCol2 & Str(lngRow2) & ":" & strCol & Str(lngRow2 + 3), " ", "")). _
                BorderAround Weight:=xlMedium, LineStyle:=xlContinuous, Color:=vbBlack
            
            lngRow = lngRow + 1                         '登録済みデータの行を1つ進める
            If strCol = "E" Then lngRow2 = lngRow2 + 4  '現在がE列なら帳票のセルを4つ下に移動
        End With
    Loop
End Sub

'******************************************************************
'バーコードコントロール作成
'******************************************************************
Sub Create_Barcode(i As Long, strCell As String)
    Dim Obj As OLEObject
    Dim ctl As BARCODELib.BarCodeCtrl
    Dim CellW As Long
    'Dim CellH As Long
    
    With Worksheets("帳票")
        .Range(strCell & CStr(i)).Select
        CellW = ActiveCell.Width
        'CellH = 42

        .OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
            Top:=ActiveCell.Top + 2, Left:=ActiveCell.Left + 2, Height:=CellH - 4, Width:=CellW - 4).Select
    End With
    
    Set Obj = Selection
    Set ctl = Obj.Object
    With ctl
        ' Style設定 2:JAN-13 3:JAN-8 6:Code39 7:Code128
        .Style = 6
        .LinkedCell = strCell & CStr(i - 3) '参照するセル
    End With
End Sub

'******************************************************************
'帳票を印刷
'******************************************************************
Sub 帳票を印刷()
    Dim i As Long
    
    With Sheets("帳票")
        For i = .Range("i1").Value To .Range("i1").Value + .Range("i2").Value - 1 Step 4
            .PrintOut
            .Range("i1").Value = .Range("i1").Value + 4
        Next i
    End With
End Sub

-Access, Excel
-, , ,