病院や施設で患者さんごとの薬を保管する配薬（与薬）カートを使っているところは多いと思いますが、普通引き出しには名札を貼って使うと思います。患者さんが出て行かれたり入ってこられたりしたときは、部屋番号が変わったりするので定期的な更新が必要になります。
電子カルテの機能で現在の患者さん一覧のCSVファイルは出力できる、あるいは名簿は作ってあるけど、そこから毎回エクセルで開いて列や行の幅を整えたり、必要な列だけを残したりする作業はちょっとしたことですが結構面倒だったりします。
そこで今回は元となるCSVファイルから、決められた書式で名札ラベルを作成するプログラムを作ることにしました。
Excel VBAで自動化
今回はPythonではなくVBAで書くことにしました。
初めての方向けに簡単に言うと、VBA（Visual Basic for Applications）というのはマイクロソフトのOffice上で動くプログラミング言語のことで、処理の自動化などに利用することができます。なお、2024年9月からは「Python in Excel」という機能でExcel上でPythonが使えるようになったみたいですが、今まで使っているPCに入っているExcelをそのまま使いたかったのでVBAにしました。
今回作成するプログラム
元となるCSVファイル：これは部屋番号、患者名、患者ID、担当医や生年月日、性別等の項目を列に持つファイルです。このCSVファイルのヘッダー部分と各項目のデータ例は以下のようなかんじです。
このファイルを元にして、
・不要な列を削除して必要な項目（部屋番号と名前）だけを残す。名前には「様」を加える。
・行、列幅を指定したサイズに整え、名札として切って使えるように枠線を引く。
・自分以外の人が使うことも考え、ダブルクリックでプログラムを動かせるようにする。
他の細かい仕様は作りながら考えていきます。
まずはシンプルに列の削除とセル書式の変更だけ
自分がいるフォルダ内のtest.csvというファイルに対して処理を行うプログラムです。
不要な列を削除する際は、後ろから削除しています。前から順に削除していくと、それより右にあるすべての列が左にくるため、コード上の列名（アルファベット）と削除前の列名が一致せず、コードがわかりにくくなってしまうからです。
Option Explicit Sub main() Dim last_row As Integer ' フォルダ内のtest.csvファイルを開く Workbooks.Open filename:=ThisWorkbook.Path & "\test.csv" Worksheets(1).Activate ' 不要な列の削除.後ろから行う Columns("F:K").delete Columns("C:D").delete Columns("A").delete ' 各枠の行の高さと列幅の設定 rows.RowHeight = 100.5 Columns(1).ColumnWidth = 13.38 ' 部屋番号枠 Columns(2).ColumnWidth = 45.5 ' 名前枠 Columns(3).ColumnWidth = 7.38 ' 「様」枠 ' ヘッダー削除 rows(1).delete ' 最終行を取得して罫線を引く. 名前の後ろのセルに"様"を追加 last_row = Cells(rows.Count, 1).End(xlUp).Row Range(Cells(1, 1), Cells(last_row, 3)).Borders.LineStyle = xlContinuous Range(Cells(1, 1), Cells(last_row, 2)).Borders(xlEdgeRight).LineStyle = xlLineStyleNone Range(Cells(1, 3), Cells(last_row, 3)).Value = "様" ' フォント設定 Cells.Font.Size = 48 Cells.ShrinkToFit = True End Sub
これを実行すると次のようなラベルが作成されます。今の段階ではこの加工後のファイルはプログラムで保存されません。
条件に合う人だけを抽出して作る
名札ラベルは毎回リスト全員分が必要になるわけではありません。そこで今回は、在院日数が7日以内の人だけを対象にラベルを作成することにしました。コードとしては、在院日数が7日より長い人の行を削除する処理を書くことにします。
Sub main() ' === ファイルを開く処理 === ' 在院日数が7日以上の場合はラベル不要なため削除 Call deleterows_by_staydays ' === 列の削除など他の処理 === End Sub Sub deleterows_by_staydays() Dim last_row As Integer Dim stay_days As Integer ' 在院日数 Dim i As Integer last_row = Cells(rows.Count, 1).End(xlUp).Row For i = last_row To 2 Step -1 stay_days = Val(Cells(i, "G").Value) If stay_days >= 8 Then rows(i).delete End if Next i End Sub
サブプロシージャ（Sub）として作り、列を削除する前にCallで呼び出します。
列の削除と同様の理由から、ここでも下から上に１行ずつ見ていくことでスキップされることなく該当する条件の行を削除していきます。また、ここでは在院日数の上限値である"8"という数字や、列名の"G"をコード中に直接書いていますが、後々わかりにくくなるため、後で定数（Const）に修正します。
VBAをファイルのダブルクリックで実行する
作ったコードを動かすには新たに作成した実行ボタンをクリックしたり、ショートカットキーを割り当てたりといろいろありますが、今回はファイルをダブルクリックすることで実行できるようにしたいと思います。
こういうときには私は今までVBScriptから起動する、という方法を取っていたのですが、ちょっと調べたところVBScriptは2027年以降、Windowsで廃止されることが決定しているとのことだったので、別の方法を取ることにしました。
PowerShellからExcelマクロを実行する
作業場であるフォルダー内に次の2つのファイルを作成します。
まずはPowerShellスクリプトから。メモ帳を開いて、下のコードを貼り付けます。2行目のパスのところ（.xlsm名）や3行目の""内のサブプロシージャ名は適当に置き換えます。名前をつけて保存するときに、文字コードはUTF-8（BOM付き）になっていることを確認して、拡張子は「.ps1」で保存します。
ファイルパスの中に日本語が入っていると、保存時の文字コードが（BOM付き）でないと上手くいかないようです。
$Excel = New-Object -ComObject Excel.Application $Workbook = $Excel.Workbooks.Open("C:\Users\***\Desktop\適当なフォルダ名\ラベル作成.xlsm") $Excel.Run("main") $Workbook.Close($false) $Excel.Quit()
次はバッチファイルです。保存時の文字コードはUTF-8のままでOKでした。拡張子は「.bat」です。こちらもファイル名（「名札ラベル_script」の部分）は適当にしてください。
@echo off chcp 65001 powershell.exe -ExecutionPolicy Bypass -File "%~dp0名札ラベル_script.ps1"
このファイルをダブルクリックすることで、PowerShellスクリプト（ps1ファイル）からExcelを起動してVBAを実行できるようになります。
ちなみに私の環境はWindows10、PowerShellのバージョンは5.1でした。
取り敢えずこれでやりたいことはできるようになりましたが、同じフォルダー内にいくつもファイルがあって、（慣れの問題かもしれませんが）実行ファイルがわかりにくい、という状況になってしまいました。
これなら素直にショートカットキーを割り当てでもした方が良かったかな、とも思いましたが、まあ初めて使ってみたので良しとしました。
以下はフォルダー内のファイル名です。
実行ファイルは少しでもわかりやすくなるよう名前を【】で強調しています。
- 名札ラベル_macro.xlsm（VBAコードが書かれたExcelファイル）
- 名札ラベル_script.ps1（PowerShellスクリプトファイル）
- 【実行】名札ラベル.bat（ダブルクリックするファイル）
- 入院患者リスト.csv（名札ラベルの元となるCSVファイル）
- 【印刷用】名札ラベル.xlsx（コードを実行して作成されたファイル）
ps1やxlsmのファイルは隠しファイルにしておいた方がすっきりするかもしれません。それか、別フォルダーを作って入れておいてもいいかも。*1
実際の運用に際して
ここはプログラミング的な部分とは別のお話になります。
今回の名札には部屋番号も付けましたが、部屋番号はカートの方で固定されており、部屋移動があった際は引き出しごと入れ替える、というような運用だと部屋番号は必要ありません。
しかし、名札を引き出しにセットする際にどの引き出しにセットすべきかすぐ見つけやすくなるし、セットする際には番号の部分だけ折って入れれば済む話なのでそのままにしました。
また、ラベルには別ファイルに記載した個別情報を付加する（例えば、自己管理の人には★を付けるとか）ことも考えましたが、別ファイルの方のメンテもあることからこのアイデアは採用しませんでした。
このへんはラベル入れ替わりの頻度とか要望とかを考慮して、どのような機能があればよいかを考えていくことになります。
参考
コード全体です。
Option Explicit Const MAX_DAYS As Long = 7 Const INPATIENT_DAYS_COL As String = "G" ' 在院日数 Sub main() Dim last_row As Integer ' フォルダ内のtest.csvファイルを開く Workbooks.Open Filename:=ThisWorkbook.Path & "\入院患者リスト.csv" Worksheets(1).Activate ' 在院日数がMAX_DAYSより長い場合はラベル不要 Call deleterows_by_staydays ' 不要な列の削除 Columns("F:K").Delete Columns("C:D").Delete Columns("A").Delete ' 各枠の行の高さと列幅の設定 Rows.RowHeight = 100.5 Columns(1).ColumnWidth = 13.38 ' 部屋番号枠 Columns(2).ColumnWidth = 45.5 ' 名前枠 Columns(3).ColumnWidth = 7.38 ' 「様」枠 ' ヘッダー削除 Rows(1).Delete ' 最終行を取得して罫線を引く. 名前の後ろのセルに"様"を追加 last_row = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(1, 1), Cells(last_row, 3)).Borders.LineStyle = xlContinuous Range(Cells(1, 1), Cells(last_row, 2)).Borders(xlEdgeRight).LineStyle = xlLineStyleNone Range(Cells(1, 3), Cells(last_row, 3)).Value = "様" ' フォント設定 Cells.Font.Size = 48 Cells.ShrinkToFit = True ' 加工後のシートを新しいブックに別ファイルとして保存する ActiveSheet.Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\【印刷用】名札ラベル.xlsx" _ , FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close SaveChanges:=False ' CSVファイルは変更を保存しないで閉じる ActiveWorkbook.Close SaveChanges:=False MsgBox "ラベルを作成しました", Buttons:=vbInformation End Sub Sub deleterows_by_staydays() Dim last_row As Integer Dim stay_days As Integer ' 在院日数 Dim i As Integer last_row = Cells(Rows.Count, 1).End(xlUp).Row For i = last_row To 2 Step -1 stay_days = Val(Cells(i, INPATIENT_DAYS_COL).Value) If stay_days > MAX_DAYS Then Rows(i).Delete End If Next i End Sub
*1:その場合はコードにも若干の修正が必要になります
