ねらい：発注明細から「発注書の自動組版→数量・単価計算→PDF出力」まで一括で回す
発注書は「ヘッダ（仕入先・発注番号・発注日・納期）」「明細（品目・数量・単価・金額）」「サマリ（小計・送料・値引き・税込合計）」「体裁（罫線・書式）」「PDF出力」を一本化すると、毎回同じ品質で、ヒューマンエラーなく出せます。VBAなら“配列I/O＋テンプレ複製＋安全な金額計算＋一括書き出し”で、件数が多くても数秒で終わります。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。
入力仕様とシート構成（壊れない最小構成）
シート構成と列の意味
- Data（発注明細）: A=仕入先ID, B=仕入先名, C=発注日, D=納期, E=品目, F=数量, G=単価, H=送料区分, I=値引き区分
例：発注日は yyyy-mm-dd、送料区分は「有/無」、値引き区分は「有/無」などの簡素な運用でOK。 - Vendor（仕入先マスタ）: A=仕入先ID, B=仕入先名, C=住所, D=担当者, E=メール, F=標準送料, G=標準値引率
- Template（発注書テンプレ）: レイアウト固定。セルにプレースホルダ（例：{{PO_NO}}, {{VENDOR}}, {{ORDER_DATE}}, {{DUE}}）を配置しておく。
重要部分の深掘り
明細は「発注日・納期・仕入先」で自然にグループ化できます。テンプレシートへはプレースホルダ差し込み方式にすると“枠・ロゴ・注意書き”を壊さず安定します。送料・値引きはマスタに標準値を持ち、明細側の区分で適用するかどうかを切り替える運用が安全です。
共通基盤：配列I/O・金額計算ユーティリティ・プレースホルダ置換
ユーティリティ関数
' ModPO_Base.bas
Option Explicit
Public Function ReadRegion(ws As Worksheet, Optional startAddr As String = "A1") As Variant
ReadRegion = ws.Range(startAddr).CurrentRegion.Value
End Function
Public Sub WriteBlock(ws As Worksheet, a As Variant, startAddr As String)
ws.Range(startAddr).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
Public Function Norm(ByVal s As Variant) As String
Norm = LCase$(Trim$(CStr(s)))
End Function
Public Function EnsureSheet(ByVal name As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
ws.Cells.Clear
Set EnsureSheet = ws
End Function
Public Sub ReplacePlaceholder(ws As Worksheet, ByVal key As String, ByVal val As String)
Dim c As Range
For Each c In ws.UsedRange.Cells
If InStr(1, CStr(c.Value), "{{" & key & "}}", vbTextCompare) > 0 Then
c.Value = Replace(CStr(c.Value), "{{" & key & "}}", val, , , vbTextCompare)
End If
Next
End Sub
Public Function RoundMoney(ByVal amount As Double, Optional ByVal mode As String = "round") As Double
Select Case LCase$(mode)
Case "ceil": RoundMoney = WorksheetFunction.RoundUp(amount, 0)
Case "floor": RoundMoney = WorksheetFunction.RoundDown(amount, 0)
Case Else: RoundMoney = WorksheetFunction.Round(amount, 0)
End Select
End Function
重要部分の深掘り
テンプレ差し込みは「UsedRange内の{{KEY}}を探して置換」の一本化がシンプルで強いです。金額の丸めは“最後にまとめて”行い、途中で何度も丸めないのが原則。四捨五入・切り上げ・切り捨ては現場ルールを一箇所で切り替え可能にしておきます。
発注書テンプレートの最低限レイアウトと差し込み位置
差し込み項目と表の構造
- ヘッダ: 発注書、発注番号、発注日、納期、仕入先名、住所、担当者
- 明細表: 品目、数量、単価、金額（B15:E? 開始を固定）。
- サマリ: 小計、送料、値引き、合計（F15:小計、F16:送料、F17:値引き、F18:合計 など固定）
重要部分の深掘り
テンプレ側で枠線・社名ロゴ・注意書き・印影などは完成させておき、VBAからは“値だけ差し込む”。明細の開始セルとサマリのセル番地は設計書で固定しておくと、コードが壊れません。
発注書自動生成：仕入先×発注日（または納期）でグループ化、PDFまで出力
生成テンプレ（貼って動く）
' ModPO_Generate.bas
Option Explicit
Public Sub GeneratePurchaseOrders(ByVal orderDate As String, Optional ByVal roundMode As String = "round", Optional ByVal groupByDue As Boolean = False)
Dim wsData As Worksheet: Set wsData = Worksheets("Data")
Dim wsVendor As Worksheet: Set wsVendor = Worksheets("Vendor")
Dim wsTpl As Worksheet: Set wsTpl = Worksheets("Template")
Dim data As Variant: data = ReadRegion(wsData)
Dim vendors As Variant: vendors = ReadRegion(wsVendor)
' 仕入先ID → マスタ（名称,住所,担当,メール,標準送料,標準値引率）
Dim mapV As Object: Set mapV = CreateObject("Scripting.Dictionary")
Dim r As Long
For r = 2 To UBound(vendors, 1)
mapV(Norm(vendors(r, 1))) = Array(vendors(r, 2), vendors(r, 3), vendors(r, 4), vendors(r, 5), _
CDbl(IIf(Len(vendors(r, 6)) = 0, 0, vendors(r, 6))), _
CDbl(IIf(Len(vendors(r, 7)) = 0, 0, vendors(r, 7))))
Next
' グループ化：仕入先ID × （発注日 or 納期）
Dim groups As Object: Set groups = CreateObject("Scripting.Dictionary")
For r = 2 To UBound(data, 1)
If Norm(data(r, 3)) = Norm(orderDate) Then
Dim keyPart As String: keyPart = IIf(groupByDue, Norm(data(r, 4)), Norm(data(r, 3)))
Dim k As String: k = Norm(data(r, 1)) & "|" & keyPart
If Not groups.Exists(k) Then
Dim col As New Collection: col.Add r: Set groups(k) = col
Else
groups(k).Add r
End If
End If
Next
If groups.Count = 0 Then
MsgBox "対象日の発注明細がありません: " & orderDate, vbExclamation
Exit Sub
End If
' 出力フォルダ的にまとめるシート（任意）
Dim wsOut As Worksheet: Set wsOut = EnsureSheet("PO_" & Replace(orderDate, "-", ""))
' 連番（例：PO-YYYYMMDD-001〜）
Dim seq As Long: seq = 1
Dim k As Variant
For Each k In groups.Keys
Dim parts() As String: parts = Split(CStr(k), "|")
Dim vendorId As String: vendorId = parts(0)
Dim groupKey As String: groupKey = parts(1) ' 発注日 or 納期キー
' マスタ情報
Dim vi As Variant
If mapV.Exists(vendorId) Then
vi = mapV(vendorId)
Else
vi = Array("不明", "", "", "", 0#, 0#)
End If
' テンプレ複製（1枚）
wsTpl.Copy After:=wsOut.Parent.Sheets(wsOut.Parent.Sheets.Count)
Dim wsPO As Worksheet: Set wsPO = wsOut.Parent.Sheets(wsOut.Parent.Sheets.Count)
wsPO.Name = "PO_" & Replace(orderDate, "-", "") & "_" & Format$(seq, "000")
' ヘッダ差し込み
ReplacePlaceholder wsPO, "PO_NO", "PO-" & Replace(orderDate, "-", "") & "-" & Format$(seq, "000")
ReplacePlaceholder wsPO, "VENDOR", CStr(vi(0))
ReplacePlaceholder wsPO, "ADDRESS", CStr(vi(1))
ReplacePlaceholder wsPO, "CONTACT", CStr(vi(2))
ReplacePlaceholder wsPO, "ORDER_DATE", orderDate
ReplacePlaceholder wsPO, "DUE", groupKey
' 明細抽出・金額計算
Dim col As Collection: Set col = groups(k)
Dim n As Long: n = col.Count
Dim lines() As Variant: ReDim lines(1 To n, 1 To 4) ' 品目,数量,単価,金額
Dim i As Long
Dim subTot As Double: subTot = 0#
Dim shipFee As Double: shipFee = 0#
Dim discountAmt As Double: discountAmt = 0#
For i = 1 To n
Dim rr As Long: rr = col(i)
Dim qty As Double: qty = CDbl(data(rr, 6))
Dim price As Double: price = CDbl(data(rr, 7))
Dim amount As Double: amount = qty * price
lines(i, 1) = data(rr, 5)
lines(i, 2) = qty
lines(i, 3) = price
lines(i, 4) = amount
subTot = subTot + amount
' 送料・値引き区分を適用（区分が「有」の明細が含まれる場合にマスタ値を適用）
If Norm(data(rr, 8)) = "有" Then shipFee = vi(4) ' 標準送料
If Norm(data(rr, 9)) = "有" Then discountAmt = discountAmt + amount * vi(5) ' 率で累積
Next
' 丸めと合計
shipFee = RoundMoney(shipFee, roundMode)
discountAmt = RoundMoney(discountAmt, roundMode)
Dim grand As Double: grand = subTot + shipFee - discountAmt
' 明細貼り込み（テンプレ上の開始セルを B15 に仮定）
wsPO.Range("B15").Resize(n, 4).Value = lines
' サマリ貼り込み（セル固定例：F15=小計、F16=送料、F17=値引き、F18=合計）
wsPO.Range("F15").Value = subTot
wsPO.Range("F16").Value = shipFee
wsPO.Range("F17").Value = discountAmt
wsPO.Range("F18").Value = grand
' 書式適用
ApplyPOFormatting wsPO, n
' PDF出力（任意）
Dim pdfPath As String: pdfPath = ThisWorkbook.Path & "\" & wsPO.Name & ".pdf"
ExportPOPdf wsPO, pdfPath
seq = seq + 1
Next
MsgBox "発注書の自動生成（" & orderDate & "）が完了しました。", vbInformation
End Sub
Private Sub ApplyPOFormatting(ByVal ws As Worksheet, ByVal lineCount As Long)
With ws
.Range("B15:E" & 14 + lineCount).NumberFormatLocal = "#,##0"
.Range("F15:F18").NumberFormatLocal = "#,##0"
.Range("B15:E" & 14 + lineCount).Borders.LineStyle = xlContinuous
.Columns("B:F").AutoFit
End With
End Sub
Private Sub ExportPOPdf(ByVal ws As Worksheet, ByVal pdfPath As String)
With ws.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.LeftMargin = Application.CentimetersToPoints(1)
.RightMargin = Application.CentimetersToPoints(1)
.TopMargin = Application.CentimetersToPoints(1)
.BottomMargin = Application.CentimetersToPoints(1)
End With
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, OpenAfterPublish:=False
End Sub
重要部分の深掘り
- 送料・値引きは「明細に区分が含まれる→マスタ値を適用」の一本化が運用に優しいです。明細ごとに送料を載せない限り、サマリで一度だけ加算。
- 値引きは率（%）なら「対象金額×率→合算→丸め」。固定額ならマスタを固定額にしてそのまま加減算。
- テンプレ複製方式は枠やロゴを壊さず、差し込み位置も固定できるので、再現性が高いです。
例題の通し方：発注日を指定→仕入先ごとに1枚ずつ生成→PDF保存
実行例
Sub Demo_RunPO()
' 発注日を yyyy-mm-dd で指定、丸めは四捨五入。納期ごとに分けたい場合は groupByDue:=True
GeneratePurchaseOrders "2025-12-18", "round", False
End Sub
期待動作：Dataの指定発注日分が仕入先×（納期または発注日）でグループ化され、Templateから複製されたシートにヘッダ・明細・サマリが差し込まれ、PO_20251218シート群ができ、各シートのPDFが保存されます。
落とし穴と対策（深掘り）
送料・値引きの重複や抜け
送料は“一度だけ”、値引きは“対象明細に限って率適用”をコードに明記。明細側の区分が空なら適用しない。これで過剰・不足を避けられます。
テンプレのセル番地変更で壊れる
明細開始セル（B15）・サマリセル（F15〜F18）をテンプレ設計書に固定。変更時は定数を一箇所で差し替えできるようにします。
金額の丸め位置が揺れて合計が合わない
サマリで合算後に丸めるのが原則。行単位で丸めると誤差が蓄積しがち。現場ルール（round/ceil/floor）を一括指定に。
マスタ欠損（住所・担当）
欠損は「不明/空」で埋めて発注書を出しつつ、別途“欠損一覧”を出すのが安全。出力後の修正導線を作ると運用が楽になります。
セル逐次書きで遅い
明細は必ず配列でまとめて貼る。高速でUIが固まらず、件数が多くても安定します。
まとめ：テンプレ複製＋差し込み＋金額計算＋PDFの型で、毎回同じ品質の発注書を
仕入先×（発注日/納期）でグループ化し、ヘッダ・明細・サマリをテンプレへ差し込み、送料・値引きはルール化、最後にPDF出力。見た目はテンプレに寄せ、VBAは“正確に差し込むだけ”にすると壊れません。