Accessによる簡易的な在庫管理システム関連です。
管理している品目にバーコードを付けてバーコードリーダで読み取らせたい場合もあるかと思います。
バーコードのフォントをインストールしなくても帳票を作れましたので、改訂しました。
サンプルダウンロード
Excel2016にて作成しました。バーコードコントロールにはOfficeのバージョンによって違いがあるようで、Excel2013やExcel2019で動作するかどうかわかりません。報告があると嬉しいです。
なお、バーコードコントロールがデザインモードにしたり、ノーマルモードにしたりすると、見た目が変わります。「どうしてだろう?」と調べてみましたが、Offinceのバグのようです(こちら)。
使い方
サンプルを作りました。「マクロ有効化」のボタンを押して、自由に書き換えてご使用ください。
「登録済みデータ」というシートに仮データが入っております。これは上述の在庫管理システムより品目データをエクスポートした状態です。
帳票に使うのはA列~C列です。
「アドイン」という名のメニューに「帳票を初期化」「登録済みデータから帳票にコピー」「帳票を印刷」の3つの項目があります。
「帳票を初期化」は「帳票」シートをクリアします。
「登録済みデータから帳票にコピー」はA列~C列のデータを「帳票」シートへコピーし、印刷用に体裁を整えています。
「帳票を印刷」はプリンタに印刷しますが、動作確認をしておりません。「帳票」シートのI1セルに開始の品目コード(数値)を、I2セルにそこからいくつのデータを印刷するかを入力しておいて、「帳票を印刷」を実行します。
バーコード読み取りアプリ(Android)
バーコードやQRコードの読み取りには専用機器が必要になりそうですが、スマートフォンを利用する手もあります。Windowsのアプリケーションにてスマートフォンと連携します。詳しくは下記の作者のホームページを参照ください。
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