VI. グループメンバーの弁当注文取り纏め
1. プログラム作成の背景
「特許出願あり」に興味を持たれた方もいると思いますが、その話は本章の最後で述べます。「I. 人生の余技として作成したプログラム」の「9. C++」で書いたように、2017年に駄待ち狐はロボットを事業化するSBUの一員となりました。そこでの業務は「特許を見る」ことだったのですが、2001年に研究所の知財・技術助成課に異動した時と同様、半端仕事も降ってきました。その一つが、搬送ロボの走行試験をやるために借りた社内他部門の廃工場の管理人です。この工場では駄待ち狐が入社した当時は会社の主力商品を生産していたのですが、工場の海外移転の波で操業停止となり、敷地の大半は物流会社に売られていました。
一部の敷地を売らなかったのは、そこにある数棟の建屋に工場と関係のない別部門が入居していたためです。残った敷地内には空き家となった工場建屋が一棟だけ残っていて、ここを借りることになったのです。搬送ロボの走行試験には20名以上が関っており、その内の半分程度が日替りで廃工場に出社することになりました。そこで問題になったのが昼ご飯です。工場近辺に食堂はなく、コンビニも持帰り弁当店も徒歩10分くらいの距離です。持帰り弁当の出来上りを待っていたら、弁当を買って帰るだけで30分かかってしまいます。
「家で作った弁当を持って来るなり、出勤途中に弁当を買って来るなりしたらええやん」と言いたいところですが、気配りができるリーダーだと思われたいSBU長は「何とかしたって下さい」と駄待ち狐に丸投げです。持帰り弁当店が配達してくれたらいいのですが、徒歩10分の店は「できません」の一言です。そこで、工場からそう遠くないところに住んでいる昔の職場仲間に相談すると「同じ会社にいた○〇子さんが○○てー（亭）っていうお弁当屋さんをやってて配達もしてるみたい」と教えてくれました。○○てーは工場から車で10～15分と遠いのですが、早速話をしに行きました。
「毎日10個以上注文してくれるなら、エリア外ですが配達します」という有難い返事。因みに配達エリア内にある職場数か所に毎日配達をしていて、職場からの注文は下記の用紙を使って朝9時半までにファックスで受付けるという話です。左上は日替り弁当でフライありの大小、フライなしの大小、やさい（多め）の5種類の該当欄に氏名を書きます。下半分はそれ以外のメニューを手書きで記入し、間違いがないように値段を書きます。全メニューでみそ汁とふりかけのオプションが選べます。自腹で買う弁当が自分で選べないというのでは文句が出ること必至ですし、出社して弁当を食べる人数は毎日変るので、この方式は打ってつけです。
ただ、毎朝注文用紙を回して記入してもらい、ファックスするという昭和なやり方は御免こうむりたいところです。○○子さんは元社員だけあって、「PDFをメールで送ってもらってもいいですよ」と言ってくれました。注文用紙も○○子さんがExcelで作ったものですが、これを自作するのは簡単です。次は注文をどうやって取り纏めるかと、メール送信をどうするかです。この時は職場で運用しているwebサーバはなく、メンバー全員がアクセスできるファイルサーバだけでした。一方、リモートのブレードPCを社員が個人で使用するシンクライアントが運用されており、サーバではありませんが24時間365日稼働するPCが使えました。
2. 解決策の概要
webサーバーは使えないので、メンバーが弁当を注文するためのExcelファイルを作成してファイルサーバに置くことにしました。ファイルは一人ずつ別々で、下記のように1ヶ月分をまとめて記入できます。ただ、当日分の取り纏めは朝9時に自動で行われるので、それまでは自由に変更できます。カレンダーが10月4日からなのは運用開始がこの日だったからで、翌月以降は1日から始っています。○○子さんから注文用紙のサンプルを貰ったのが9月28日(木)で運用開始が10月4日(水)というスピード感に驚愕して下さい。
画像を新しいタブで開くと高解像度で見ることができます。
ファイル内に個人を識別する情報はなく、ファイル名が注文者の氏名となっています。新たに注文を開始したい人は、ファイルサーバ上にある「個人注文シート_2017年10月」フォルダにアクセスすれば、既に注文している人達のファイル群の最初に「_コピーしてファイル名を氏名に変更.xlsx」があります。ユーザは搬送ロボのソフト開発をやっているコンピュータのプロなので、「当日朝9時までに書込んで下さい」とだけ言えば以心伝心です。もちろん、○○てーのメニューシステムについての説明はしましたし、お店のwebサイト（上記プリントアウトからは削除）には実際のメニューが掲載されています。
個人注文シートから注文用紙を作成するExcelマクロは次節で紹介しますが、この中にはメールの自動送信まで含まれています。○○子さんから「支払いは1ヶ月分まとめてでもいいですよ」と言われていたので、個人ごとの1ヶ月分の代金を集計する機能も付けました。最後の難関が集金だと思っていたので、毎日ではなく月1回でいいというのは助かりました。それにしても、現金を20数名から回収するのは大変でした。今なら何らかのキャッシュレスサービスの利用を考えたかもしれません。逆に当時は銀行のATMで小銭を何枚でも預金できたので、○○てーに小銭をジャラジャラ持って行くという不細工なことにはなりませんでした。
マクロを仕込んだExcelはリモートPC上に置いて、タスクスケジューラで毎朝9時に自動で実行します。これで集金作業以外は全て自動化されたと言いたいところですが、PCは時々機嫌を損ねます。月に1回程度ですが、うまくメールが送信されないことがありました。その対策として、マクロの自動実行の前にこれも自動でPCの再起動をすることにしましたが、それでもトラブルは発生します。結局、このシステムの運用が終る翌年の6月まで、毎朝9時～9時半の間にメールが送信されたかどうかを確認する羽目になりました。それでもこの確認はリモートでできるので、注文用紙を回すやり方に比べれば圧倒的な工数削減です。
3. VBAプログラム
このシステムの動作確認に必要な最低限のファイルはZIPでダウンロードできます。解凍していただくと以下の構成になっています。
ファイルサーバ上 # このフォルダの中身はファイルサーバ上にある
└ 個人注文シート_2017年10月 # 当該月度の個人注文シートのフォルダ
├ _コピーしてファイル名を氏名に変更.xlsx # 個人注文シートの雛型
├ Ａ山○○.xlsx # 個人注文シート（26ファイル）
：
注文集計シート_2017年10月 # ここ以下はリモートPC上にある
├ _個人注文金額集計.xlsx # 10月30日時点のExcelファイル（日々書換え）
└ 30日_個人注文金額集計.pdf # 10月30日時点のPDFファイル（本来は日数分）
_個人注文金額集計.xlsx # 個人注文金額集計ファイルの雛型
_注文集計シート.xlsm # マクロが仕込まれた空の注文集計シート
"_注文集計シート.xlsm"のマクロを実行すると（マクロの実行はセキュリティ設定で禁止されていると思いますが、敢えてここには解除方法を書きません。自力で解除するスキルのある方のみお試し下さい）、以下に赤字で示すファイルが増えます。この際、メールも自動送信されるのでご注意下さい。送信先は○○てーではなく駄待ち狐なので送ってもらっても構いませんが、送信元のメールアドレスが駄待ち狐に知られてしまいます。
ファイルサーバ上
└ 個人注文シート_2017年10月
├ _コピーしてファイル名を氏名に変更.xlsx
├ Ａ山○○.xlsx
：
└ 本日の注文集計シート.pdf # 一般ユーザが注文内容を確認するためのコピー
注文集計シート_2017年10月
├ _個人注文金額集計.xlsx # 10月31日時点のExcelファイルに更新
├ 30日_個人注文金額集計.pdf
├ 31日_個人注文金額集計.pdf # 10月31日時点のPDFファイル
└ 31日_注文集計シート.pdf # 注文履歴として残すためのコピー
_個人注文金額集計.xlsx
_注文集計シート.pdf # マクロで生成した原本でメール添付に使う
_注文集計シート.xlsm
新たに生成される"_注文集計シート.pdf"は以下の通りで、これがメールに添付されます。ファックス注文用紙と全く同じと言いたいところですが、「やさい」の欄が2個から4個に増えています。注文が多すぎて1枚の注文用紙に収まらない場合は2枚以上にするという処理もマクロに入れてありますが、「やさい」の注文が3個でそのために2枚になるということが2回あったので、この欄を増やしました。「フライなし」も「やさい」もユーザの健康志向に対応するものですが、ユーザ目線に立った○○子さんのメニュー作りに感心します。
"_注文集計シート.xlsm"に仕込んであるマクロは以下の通りです。適宜コメントを入れてあるので逐行解説はしませんが、メインプログラムである"Sub isnot_Workbook_Open()"（3～427行目）と、メインプログラムが使うサブルーチン"Private Sub WriteSumSheet()"（429～456行目）および"Private Sub ClearSumSheet()"（458～482行目）から成っています。メインプログラムの本来の名前は"Workbook_Open()"で、この場合は"_注文集計シート.xlsm"を開くと同時にマクロが実行されます。また、"_注文集計シート.xlsm"のH1セルは関数"=TODAY()"になっていて、マクロは当日の日付で実行されます。
コードの表示にはPrism.jsを使用しています。prism.cssの設定は団塊爺ちゃんの備忘録を参考にしました。
Option Explicit
Sub isnot_Workbook_Open()
Dim I As Integer, J As Integer, K As Integer, L As Integer
Dim sumYear As Integer, sumMnth As Integer, sumDate As Integer
Dim shtNum As Integer, shtFul As Integer
Dim clmSta As Integer, clmNum As Integer, Jmax As Integer
Dim pfldPath As String, mfldPath As String
Dim servPath As String, datfldPath As String
Dim flName As String, ctmName As String
Dim menu0 As Variant, menu01 As Variant, menu02 As Variant
Dim menu1() As String, menu2() As String, menu3() As String
Dim menu4() As String, menu5() As String, menu6() As String
Dim menu11() As Boolean, menu21() As Boolean, menu31() As Boolean
Dim menu41() As Boolean, menu51() As Boolean, menu61() As Boolean
Dim menu12() As Boolean, menu22() As Boolean, menu32() As Boolean
Dim menu42() As Boolean, menu52() As Boolean, menu62() As Boolean
Dim menu63() As String, menu64() As Integer
Dim ctmList() As String, ctmSum() As Integer, ovwFlg As Boolean
Dim olApp As Outlook.Application, mailObj As Outlook.MailItem
Dim AtcObj As Outlook.Attachments
Dim cntFlg As Integer
Dim sumNum As Integer, sumMon As Integer
Dim ordFlg As Boolean, chgFlg As Boolean
shtNum = 1
sumNum = 0
sumMon = 0
ReDim menu1(1)
ReDim menu2(1)
ReDim menu3(1)
ReDim menu4(1)
ReDim menu5(1)
ReDim menu6(1)
ReDim menu11(1)
ReDim menu21(1)
ReDim menu31(1)
ReDim menu41(1)
ReDim menu51(1)
ReDim menu61(1)
ReDim menu12(1)
ReDim menu22(1)
ReDim menu32(1)
ReDim menu42(1)
ReDim menu52(1)
ReDim menu62(1)
ReDim menu63(1)
ReDim menu64(1)
ReDim ctmList(1)
ReDim ctmSum(1)
Call ClearSumSheet
sumYear = Year(ThisWorkbook.Worksheets(1).Cells(1, 8).Value)
sumMnth = Month(ThisWorkbook.Worksheets(1).Cells(1, 8).Value)
sumDate = Day(ThisWorkbook.Worksheets(1).Cells(1, 8).Value)
pfldPath = ThisWorkbook.Path
servPath = ThisWorkbook.Path & "\ファイルサーバ上"
datfldPath = servPath & "\個人注文シート_" & sumYear & "年" & sumMnth & "月"
flName = Dir(datfldPath & "\*.xlsx")
Do Until flName = ""
If Left(flName, 11) <> "_コピーしてファイル名" Then
ctmName = Replace(flName, ".xlsx", "")
Workbooks.Open datfldPath & "\" & flName
chgFlg = False
ctmList(UBound(ctmList)) = ctmName
ReDim Preserve ctmList(UBound(ctmList) + 1)
'その日の個人注文金額を配列に格納し、合計数・合計金額を加算
With Workbooks(flName).Worksheets("Sheet1")
For I = 9 To 49 Step 10
For J = 3 To 7
If .Cells(I, J).Value = sumDate Then
ctmSum(UBound(ctmSum)) = 0
ordFlg = False
If .Cells(I + 9, J).Value <> "\" Then
ctmSum(UBound(ctmSum)) = ctmSum(UBound(ctmSum)) + .Cells(I + 9, J).Value
If ctmSum(UBound(ctmSum)) <> 0 Then
ordFlg = True
End If
End If
For K = 1 To 5
If .Cells(I + K, J) <> "" Then
If ordFlg Then
.Cells(I + K, J).Value = ""
chgFlg = True
Else
ctmSum(UBound(ctmSum)) = ctmSum(UBound(ctmSum)) + .Cells(I + K, 2).Value
ordFlg = True
End If
End If
Next K
For K = 6 To 7
If .Cells(I + K, J) <> "" Then
If ordFlg Then
ctmSum(UBound(ctmSum)) = ctmSum(UBound(ctmSum)) + .Cells(I + K, 2).Value
Else
.Cells(I + K, J).Value = ""
chgFlg = True
End If
End If
Next K
If ctmSum(UBound(ctmSum)) <> 0 Then
sumNum = sumNum + 1
sumMon = sumMon + ctmSum(UBound(ctmSum))
End If
ReDim Preserve ctmSum(UBound(ctmSum) + 1)
'その日の各メニューの配列に注文者氏名を入力
For K = 1 To 5
If .Cells(I + K, J).Value <> "" Then
Select Case K
Case 1
menu1(UBound(menu1)) = ctmName
ReDim Preserve menu1(UBound(menu1) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu11(UBound(menu11)) = True
Else
menu11(UBound(menu11)) = False
End If
ReDim Preserve menu11(UBound(menu11) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu12(UBound(menu12)) = True
Else
menu12(UBound(menu12)) = False
End If
ReDim Preserve menu12(UBound(menu12) + 1)
Case 2
menu2(UBound(menu2)) = ctmName
ReDim Preserve menu2(UBound(menu2) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu21(UBound(menu21)) = True
Else
menu21(UBound(menu21)) = False
End If
ReDim Preserve menu21(UBound(menu21) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu22(UBound(menu22)) = True
Else
menu22(UBound(menu22)) = False
End If
ReDim Preserve menu22(UBound(menu22) + 1)
Case 3
menu3(UBound(menu3)) = ctmName
ReDim Preserve menu3(UBound(menu3) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu31(UBound(menu31)) = True
Else
menu31(UBound(menu31)) = False
End If
ReDim Preserve menu31(UBound(menu31) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu32(UBound(menu32)) = True
Else
menu32(UBound(menu32)) = False
End If
ReDim Preserve menu32(UBound(menu32) + 1)
Case 4
menu4(UBound(menu4)) = ctmName
ReDim Preserve menu4(UBound(menu4) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu41(UBound(menu41)) = True
Else
menu41(UBound(menu41)) = False
End If
ReDim Preserve menu41(UBound(menu41) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu42(UBound(menu42)) = True
Else
menu42(UBound(menu42)) = False
End If
ReDim Preserve menu42(UBound(menu42) + 1)
Case 5
menu5(UBound(menu5)) = ctmName
ReDim Preserve menu5(UBound(menu5) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu51(UBound(menu51)) = True
Else
menu51(UBound(menu51)) = False
End If
ReDim Preserve menu51(UBound(menu51) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu52(UBound(menu52)) = True
Else
menu52(UBound(menu52)) = False
End If
ReDim Preserve menu52(UBound(menu52) + 1)
End Select
End If
Next K
If .Cells(I + 8, J).Value <> "" Then
menu6(UBound(menu6)) = ctmName
ReDim Preserve menu6(UBound(menu6) + 1)
menu63(UBound(menu63)) = .Cells(I + 8, J).Value
ReDim Preserve menu63(UBound(menu63) + 1)
menu64(UBound(menu64)) = .Cells(I + 9, J).Value
ReDim Preserve menu64(UBound(menu64) + 1)
If .Cells(I + 6, J).Value <> "" Then
menu61(UBound(menu61)) = True
Else
menu61(UBound(menu61)) = False
End If
ReDim Preserve menu61(UBound(menu61) + 1)
If .Cells(I + 7, J).Value <> "" Then
menu62(UBound(menu62)) = True
Else
menu62(UBound(menu62)) = False
End If
ReDim Preserve menu62(UBound(menu62) + 1)
End If
End If
Next J
Next I
End With
If chgFlg Then
Workbooks(flName).Save
End If
Workbooks(flName).Close
End If
flName = Dir()
Loop
'個人注文シートに該当日がない場合(土日)は、プログラムを終了
If UBound(ctmSum) = 1 Then
GoTo EndLabel
End If
'シート枚数を決定
shtNum = Int(WorksheetFunction.Max((UBound(menu1) - 2) / 5, (UBound(menu2) - 2) / 3, _
(UBound(menu3) - 2) / 5, (UBound(menu4) - 2) / 3, (UBound(menu5) - 2) / 4, _
(UBound(menu6) - 2) / 8, 0)) + 1
ThisWorkbook.Worksheets(1).Cells(21, 12).Value = shtNum
For I = 2 To shtNum
ThisWorkbook.Worksheets(1).Copy After:=Worksheets(I - 1)
ThisWorkbook.Worksheets(I).Cells(21, 11).Value = I
Next I
'注文者氏名をシートに記入
clmSta = 3
clmNum = 5
menu0 = menu1()
menu01 = menu11()
menu02 = menu12()
Call WriteSumSheet(clmSta, clmNum, menu0, menu01, menu02)
clmSta = 8
clmNum = 3
menu0 = menu2()
menu01 = menu21()
menu02 = menu22()
Call WriteSumSheet(clmSta, clmNum, menu0, menu01, menu02)
clmSta = 11
clmNum = 5
menu0 = menu3()
menu01 = menu31()
menu02 = menu32()
Call WriteSumSheet(clmSta, clmNum, menu0, menu01, menu02)
clmSta = 16
clmNum = 3
menu0 = menu4()
menu01 = menu41()
menu02 = menu42()
Call WriteSumSheet(clmSta, clmNum, menu0, menu01, menu02)
clmSta = 19
clmNum = 4
menu0 = menu5()
menu01 = menu51()
menu02 = menu52()
shtFul = Int((UBound(menu0) - 1) / clmNum)
Call WriteSumSheet(clmSta, clmNum, menu0, menu01, menu02)
clmNum = 8
shtFul = Int((UBound(menu6) - 1) / clmNum)
For I = 0 To shtFul - 1
For J = 1 To clmNum
K = Int((J - 1) / 4)
L = J - K * 4 - 1
ThisWorkbook.Worksheets(I + 1).Cells(24 + K * 5, L * 3 + 1).Value = menu6(I * clmNum + J)
ThisWorkbook.Worksheets(I + 1).Cells(27 + K * 5, L * 3 + 1).Value = menu63(I * clmNum + J)
ThisWorkbook.Worksheets(I + 1).Cells(28 + K * 5, L * 3 + 1).Value = menu64(I * clmNum + J)
If menu61(I * clmNum + J) Then
ThisWorkbook.Worksheets(I + 1).Cells(25 + K * 5, L * 3 + 3).Value = "〇"
End If
If menu62(I * clmNum + J) Then
ThisWorkbook.Worksheets(I + 1).Cells(26 + K * 5, L * 3 + 3).Value = "〇"
End If
Next J
Next I
For J = 1 To UBound(menu6) - shtFul * clmNum - 1
K = Int((J - 1) / 4)
L = J - K * 4 - 1
ThisWorkbook.Worksheets(shtFul + 1).Cells(24 + K * 5, L * 3 + 1).Value = menu6(shtFul * clmNum + J)
ThisWorkbook.Worksheets(shtFul + 1).Cells(27 + K * 5, L * 3 + 1).Value = menu63(shtFul * clmNum + J)
ThisWorkbook.Worksheets(shtFul + 1).Cells(28 + K * 5, L * 3 + 1).Value = menu64(shtFul * clmNum + J)
If menu61(shtFul * clmNum + J) Then
ThisWorkbook.Worksheets(shtFul + 1).Cells(25 + K * 5, L * 3 + 3).Value = "〇"
End If
If menu62(shtFul * clmNum + J) Then
ThisWorkbook.Worksheets(shtFul + 1).Cells(26 + K * 5, L * 3 + 3).Value = "〇"
End If
Next J
'合計数と合計金額を記入
ThisWorkbook.Worksheets(1).Cells(6, 9).Value = sumNum
ThisWorkbook.Worksheets(1).Cells(16, 9).Value = sumMon
'注文集計シートをPDF化し、当月フォルダとサーバにも保存
ThisWorkbook.Worksheets.Select
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pfldPath & "\_注文集計シート.pdf"
mfldPath = pfldPath & "\注文集計シート_" & sumYear & "年" & sumMnth & "月"
If Dir(mfldPath, vbDirectory) = "" Then
MkDir mfldPath
FileCopy pfldPath & "\_個人注文金額集計.xlsx", mfldPath & "\_個人注文金額集計.xlsx"
End If
FileCopy pfldPath & "\_注文集計シート.pdf", mfldPath & "\" & sumDate & "日_注文集計シート.pdf"
FileCopy pfldPath & "\_注文集計シート.pdf", servPath & "\本日の注文集計シート.pdf"
'個人注文金額を集計してPDF化
Workbooks.Open mfldPath & "\_個人注文金額集計.xlsx"
With Workbooks("_個人注文金額集計.xlsx").Worksheets(1)
For I = 1 To 1000
If .Cells(I, 1).Value = "合計金額" Then
.Range(Cells(I, 1), Cells(I, 3)).ClearContents
Exit For
End If
Next I
If .Cells(1, 2).Value > sumDate Then
.Range(Cells(2, 1), Cells(1000, 3)).ClearContents
End If
If .Cells(1, 2).Value = sumDate Then
ovwFlg = True
Else
ovwFlg = False
.Cells(1, 2).Value = sumDate
End If
For I = 1 To UBound(ctmList) - 1
Jmax = 0
For J = 1 To 1000
If .Cells(J, 1).Value = "" Then
Jmax = J
Exit For
ElseIf .Cells(J, 1).Value = ctmList(I) Then
If ovwFlg Then
.Cells(J, 3).Value = .Cells(J, 3).Value - .Cells(J, 2).Value + ctmSum(I)
Else
.Cells(J, 3).Value = .Cells(J, 3).Value + ctmSum(I)
End If
.Cells(J, 2).Value = ctmSum(I)
Exit For
End If
Next J
If Jmax <> 0 Then
.Cells(Jmax, 1).Value = ctmList(I)
.Cells(Jmax, 2).Value = ctmSum(I)
.Cells(Jmax, 3).Value = ctmSum(I)
End If
Next I
For J = 1 To 1000
If .Cells(J, 1).Value = "" Then
Jmax = J
Exit For
End If
Next J
.Cells(Jmax + 1, 1).Value = "合計金額"
.Cells(Jmax + 1, 2).Formula = "=Sum(B2:B" & Jmax & ")"
.Cells(Jmax + 1, 3).Formula = "=Sum(C2:C" & Jmax & ")"
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=mfldPath & "\" & sumDate & "日_個人注文金額集計.pdf"
End With
Workbooks("_個人注文金額集計.xlsx").Save
Workbooks("_個人注文金額集計.xlsx").Close
'注文メールを送信する
Set olApp = CreateObject("Outlook.Application")
Set mailObj = olApp.CreateItem(olMailItem)
Set AtcObj = mailObj.Attachments
mailObj.BodyFormat = olFormatPlain
mailObj.To = "fox@bidingfox.xii.jp"
mailObj.Subject = "本日分の注文をします"
mailObj.Body = "○○てー様" & vbCrLf & vbCrLf _
& " お世話になります｡△△△△です｡" & vbCrLf & vbCrLf _
& " 添付ファイルにて本日分の注文をいたしますので､" & vbCrLf _
& "よろしくお願いします｡" & vbCrLf & vbCrLf _
& "以上" & vbCrLf _
& "------------------------------------------------------" & vbCrLf _
& "（会社名）" & vbCrLf _
& "（部署名）" & vbCrLf _
& "〒***-**** （住所）" & vbCrLf _
& "Tel: ***-****-****" & vbCrLf
AtcObj.Add pfldPath & "\_注文集計シート.pdf"
mailObj.Send
Set AtcObj = Nothing
Set mailObj = Nothing
Set olApp = Nothing
EndLabel:
If Workbooks.Count <= 1 Then
Application.Quit
End If
Application.DisplayAlerts = False
ThisWorkbook.Close
Application.DisplayAlerts = True
End Sub
Private Sub WriteSumSheet(clmSta As Integer, clmNum As Integer, _
menu0 As Variant, menu01 As Variant, menu02 As Variant)
Dim I As Integer, J As Integer, shtFul As Integer
shtFul = Int((UBound(menu0) - 1) / clmNum)
For I = 0 To shtFul - 1
For J = 1 To clmNum
ThisWorkbook.Worksheets(I + 1).Cells(clmSta + J, 3).Value = menu0(I * clmNum + J)
If menu01(I * clmNum + J) Then
ThisWorkbook.Worksheets(I + 1).Cells(clmSta + J, 5).Value = "〇"
End If
If menu02(I * clmNum + J) Then
ThisWorkbook.Worksheets(I + 1).Cells(clmSta + J, 6).Value = "〇"
End If
Next J
Next I
For J = 1 To UBound(menu0) - shtFul * clmNum - 1
ThisWorkbook.Worksheets(shtFul + 1).Cells(clmSta + J, 3).Value = menu0(shtFul * clmNum + J)
If menu01(shtFul * clmNum + J) Then
ThisWorkbook.Worksheets(shtFul + 1).Cells(clmSta + J, 5).Value = "〇"
End If
If menu02(shtFul * clmNum + J) Then
ThisWorkbook.Worksheets(shtFul + 1).Cells(clmSta + J, 6).Value = "〇"
End If
Next J
End Sub
Private Sub ClearSumSheet()
Dim I As Integer, J As Integer, shtNum As Integer
shtNum = ThisWorkbook.Worksheets.Count
Application.DisplayAlerts = False
For I = shtNum To 2 Step -1
ThisWorkbook.Worksheets(I).Delete
Next I
Application.DisplayAlerts = True
ThisWorkbook.Worksheets(1).Activate
ThisWorkbook.Worksheets(1).Range(Cells(4, 3), Cells(23, 6)).ClearContents
For I = 0 To 5 Step 5
For J = 0 To 12 Step 3
ThisWorkbook.Worksheets(1).Range(Cells(24 + I, 1 + J), Cells(24 + I, 2 + J)).ClearContents
ThisWorkbook.Worksheets(1).Range(Cells(25 + I, 3 + J), Cells(26 + I, 3 + J)).ClearContents
ThisWorkbook.Worksheets(1).Range(Cells(27 + I, 1 + J), Cells(27 + I, 3 + J)).ClearContents
ThisWorkbook.Worksheets(1).Range(Cells(28 + I, 1 + J), Cells(28 + I, 3 + J)).ClearContents
Next J
Next I
ThisWorkbook.Worksheets(1).Cells(21, 12).Value = 1
End Sub
"_注文集計シート.xlsm"に以上の細工がしてあるので、次節で紹介するタスクスケジューラの処理は毎朝9時に"_注文集計シート.xlsm"を開くだけです。336～391行目の個人注文金額の集計では、"注文集計シート_20**年**月"フォルダにある"_個人注文金額集計.xlsx"ファイルを上書き更新していきますが、以下に示すPDFにして毎日保存していくので履歴を追うことができます。個人注文シートはユーザが自由に書換えられるので、これをベースに注文金額の集計をしたのでは月末になってから月内の注文を削除された時に困ってしまいます。故意か過失かは分りませんが、実際にそういうこともありました。
4. タスクスケジューラ
タスクスケジューラはWindows OSに標準で装備されているプログラム自動実行ツールです。使い方の詳細は「windows タスクスケジューラ」でグーグれば出てくると思いますが、Windows 10でも11でもGUIを使って簡単に設定できます。タスクスケジューラを起動すると以下の真ん中のウィンドウが開き、「基本タスクの作成...」をクリックすると右側のサブウィンドウが開きます。その指示に従って自動実行するタイミングと実行するプログラムを設定していきます。「タスクスケジューラライブラリ」をクリックすると左に示すタスクの一覧が表示され、作成したタスク名をダブルクリックすれば設定内容の変更が可能になります。
タスクスケジューラで実行するのは下記上段のバッチファイルです。"_注文集計シート.xlsm"を開くだけなので1行で終りです。startコマンドの最初の引数は新しく開くウィンドウの名称ですが、特に名前を付ける必要もないのでブランクにしてあります。2番目の引数がExcelアプリケーションのexeファイルで、3番目が"_注文集計シート.xlsm"です。その下に示したバッチファイルは自動でPCの再起動をするもので、"○○てー注文自動送信.bat"を起動する30分前に実行するようにタスクスケジューラで設定していました。ただ、このおまじないにあまり効果がなかったのは既に述べた通りです。
START "" "C:\Program Files\Microsoft Office\...\EXCEL.EXE" "C:\Users\...\_注文集計シート.xlsm"
SHUTDOWN /R /T 60
5. 特許出願
特許に馴染みのない方には「世の中を変えるような画期的なものを発明したら特許を取って大儲けする」というイメージがあると思います。確かにそういうケースもあって、中村修二先生の青色発光ダイオードなどは正にその例です。しかし、そんなノーベル賞級の発明はめったに生れるものではありません。一方、会社で技術開発をやっていると、特許を出願することはある種のノルマになっています。その結果、今までにあったもののちょっとした改良を発明として出願することになります。そこで問題になるのが、「大儲け」と言わないまでもその特許で儲けられるかどうかです。
ちょっとした改良なら同じようなことを別の手段で実現するのは容易ですから、「他社がその発明を使えないから自社製品がバンバン売れる」こともないし、「他社に発明を使わせる代わりに高い特許使用料を取る」こともできません。この大したことのない発明でどうやって儲けるかという点に関して、駄待ち狐が若い頃に言われていたのは「できるだけ抽象化・上位概念化して権利を取る」ことです。その心は「今考えているピンポイントの製品応用だけではなく他の分野の製品でも使われるかもしれない」ということなのですが、そんなあなた任せのやり方ではノーベル賞発明が生れるよりも低い確率でしか大儲けはできません。
そんな中、米国発で出てきたのが「ビジネスモデル特許」（特許の専門家は「ビジネス方法特許」と呼びます）です。これはコンピュータを利用することで今までになかったビジネスのやり方を編み出して、それを発明として特許を取るというというものです。有名な例ではAmazonの「ワンクリック特許」があります。この発明が特許の要件を満しているかどうかという議論は特許専門家の間でも喧々諤々ありましたが、「大したことのない」発明であることには誰も異論はないと思います。しかし、その大したことのない発明でAmazonは大儲けしました。
以上のことを止揚（Aufheben）すると出てくる考え方が、「発明を抽象化・上位概念化する際に製品分野を問わない方向にするのではなく、製品分野やユースケースは限定的でいいので解決手段の方を抽象化して、実現したいコトを特許請求の範囲にする」というものです。駄待ち狐のかつての同僚で「ビデオの追っかけ再生で特許を取って大儲けした」と吹聴する人がいましたが、これが正にその例です。テープでは追っかけ再生は不可能でしたが、ハードディスク（HD）なら技術的には難しい話ではありませんし、出願した時点で既にHDレコーダはありました。追っかけ再生できるモノではなく、追っかけ再生というコトを特許にしたのです。
前置きが長くなりましたが、これらの諸々のことを踏まえて駄待ち狐は弁当注文システムを特許として出願することにしました。それがこの特開2019-113973です。ポイントは個人注文シートを注文集計シートに変換するところですが、ネット通販ではそれに類することをやっているでしょうからユースケースを弁当注文に限定しました。そうなると「自社の事業に」役立つ特許だと説明できないので、出願はしましたが審査請求はしませんでした。出願した特許は1年半経つと公開されますが、審査請求しなければ登録される（特許庁が特許として認める）ことはありません。因みに論文・特許リストに載せている特許は全て登録されたものです。
もし、駄待ち狐のサイトを最初から読んで下さっている方がいたとすれば、これから書くことについて大方の予想はつくと思います。ヒントは「このシステムの運用が終る翌年の6月まで」です。そうです、このシステムもまた9ヶ月で終焉を迎えました。その原因は2018年6月18日7時58分に発生した大阪北部地震です。老朽化していた廃工場は、この地震で倒壊こそしませんでしたが建屋内部は大きな被害を受けました。片付ければ使えないこともなかったのですが、今さら耐震補強工事をする訳にもいかず、従業員の安全が担保できないということでそこでの開発は中止になりました。
「天は我々を見放した」ならぬ「天も駄待ち狐を見放した」といったところですが、正直なところ弁当注文システムの運用が中止になったことにはホッとしました。毎朝9時～9時半の間にメールが送信されたかどうかを確認するというのはやはり面倒なことでした。そもそも駄待ち狐の趣味はプログラムを作成することであって、それに基づいてシステムを運用することではありません。もちろん、実際に運用して「使える」プログラムかどうかを見極めるところまでは趣味の領域ですが、9ヶ月も運用すれば十分です。この地震で被害を受けられた方々には不謹慎ながら、ここは「天が駄待ち狐に味方した」です。