困っていること

あるグループにおけるメンバの勤務予定が書かれたExcelファイルがある。
明日○○さんは出勤だっけ？テレワークだっけ？とパッと確認したい時、Excelを起動するのは面倒でもある。
（すべては低スペックな手元のPCが原因ではある…。）

解決方法

じゃあExcel起動よりももっと軽いものをと考えた時、ふと思いついたのがローカルHTMLファイルをWebブラウザで読み込む方法である。
業務の都合上、Webブラウザ(Google Chromeを使用)はほぼ常に起動している。
ならブックマークバーにでもローカルHTMLファイルを登録しておけば、パッと確認できるのではないか？と思ったわけだ。
その為には定型フォーマットを持つExcelファイルの内容をHTMLファイルに書き出す仕組みが必要になる。
よし、スクリプトを書こう！←

実際に書いてみた

まず勤務表のフォーマットについては以下の画像のようなイメージだ。
(メンバの氏名は架空のものになっている。こういう時に人名ランダム生成スクリプトは便利だ(自画自賛))
特徴としては、月毎に別ファイルにするのではなく、横に伸びていくような表になっていることか。

では実際に書いてみたVBScriptのコードをぺたり。

Option Explicit

'******************
'*** 手動定義部 ***
'******************

'*** 成果物HTMLの出力先
Dim initResultFilePath : initResultFilePath = "D:\work\Get-ExcelCells\Result.html"

'*** 勤務表のフルパス　※SS = Shift Schedule
Dim initSSFilePath : initSSFilePath         = "D:\work\Get-ExcelCells\勤務表.xlsx"

'*** 勤務表のSheet名　※SS = Shift Schedule
Dim initSSSheetName : initSSSheetName       = "勤務表"

'*** 勤務表の「年月」が記載されている列数
Dim initYYYYMMRow : initYYYYMMRow           = 5

'*** 勤務表の「日付」が記載されている列数
Dim initDDRow : initDDRow                   = 6

'*** 勤務表の「曜日」が記載されている列数
Dim initWeekDayRow : initWeekDayRow         = 7

'*** 勤務表の参照すべき最初のメンバが記載されている行数
Dim initMemberHeadRow : initMemberHeadRow   = 8

'*** 勤務表の参照すべき最後のメンバが記載されている行数
Dim initMemberTailRow : initMemberTailRow   = 16

'*** 勤務表のメンバが記載されている列数
Dim initMemberColumn : initMemberColumn     = 3


'******************
'*** 初期設定部 ***
'******************

'*** Microsoft Excelを扱う為、これを変数設定
Dim AppExcel
Set AppExcel = CreateObject("Excel.Application")

'*** 手動定義した勤務表のフルパスからワークブックを変数設定
Dim oWorkBook
Set oWorkBook = AppExcel.Workbooks.Open(initSSFilePath,,True)

'*** 手動定義した勤務表のフルパスからワークシートを変数設定
Dim oWorkSheet
Set oWorkSheet = oWorkBook.WorkSheets(initSSSheetName)

'*** スクリプト実行日時から、各種日時文字列を変数設定
Dim sNow, sYYYYNow, sMMNow, sDDNow
sNow     = NOW
sYYYYNow = Year(sNow)
sMMNow   = Right("00"&Month(sNow),2)
sDDNow   = Right("00"&Day(sNow),2)


'******************
'*** 主要処理部 ***
'******************

'*** 取回し用Index変数を用意
Dim iRow, iColumn
Dim iStartColumn

'*** 取回し用Index変数を初期化
iRow    = initYYYYMMRow
iColumn = 1 '(後にFor文内で再定義しているので実質意味なし)

'*** 勤務表の「年月」列に対して、現在年月列を探索
'???解説???
'   途中のIf文の論理式部分について。
'   勤務表の「年月」列は表記上は「YYYY年MM月」だが、内部的には「YYYY/MM/DD」であり、
'   各種日時文字列とそのまま比較できない為、CInt関数で数値化している
For iColumn = 1 To 99
    If Left(oWorkSheet.Cells(iRow, iColumn), Len("YYYY/MM")) = sYYYYNow&"/"&sMMNow Then
        '*** 後続の現在日付列の探索開始列を設定
        iStartColumn = iColumn
        Exit For
    End If
Next
'*** 勤務表の「年月」列に対して、現在年月に該当する列が見つからない場合にはError終了
If iColumn > 99 Then
    msgbox "["&sYYYYNow&"年"&sMMNow&"月] column is not found." & vbCrLf _
         & "ExitCode:0x1",,"Error"
    WScript.Quit 1
End If

'*** 勤務表の現在年月に該当する箇所を元に、現在日付列を探索
For iColumn = iStartColumn To iStartColumn + 31
    If CInt(oWorkSheet.Cells(initDDRow, iColumn)) = CInt(sDDNow) Then
        '*** 勤務予定の取得開始列を設定
        iStartColumn = iColumn
        Exit For
    End If
Next
'*** 勤務表の「日付」列に対して、現在日付に該当する列が見つからない場合にはError終了
If iColumn > iStartColumn + 31 Then
    msgbox "["&sDDNow&"] column is not found in ["&sYYYYNow&"年"&sMMNow&"月] block."  & vbCrLf _
         & "ExitCode:0x2",,"Error"
    WScript.Quit 2
End If

'*** 成果物HTMLの冒頭～テーブル定義開始を記述
Dim sHTML
sHTML = sHTML     & "<html><body>" & vbCrLf
sHTML = sHTML     & "  <table border='1' rules='all'>" & vbCrLf

'*** 成果物HTMLのテーブルヘッダその１(日付)を作成
sHTML = sHTML     & "    <tr>" & vbCrLf
sHTML = sHTML     & "      <th width='99'></th>" & vbCrLf
For iColumn = iStartColumn To iStartColumn + 6 '(開始日含めて7日間なので+6)
    sHTML = sHTML & "      <th width='60'>"&CInt(sMMNow)&"/"&oWorkSheet.Cells(initDDRow, iColumn)&"</tb>" & vbCrLf
Next
sHTML = sHTML     & "    </tr>" & vbCrLf

'*** 成果物HTMLのテーブルヘッダその２(曜日)を作成
sHTML = sHTML     & "    <tr>" & vbCrLf
sHTML = sHTML     & "      <th width='99'></th>" & vbCrLf
For iColumn = iStartColumn To iStartColumn + 6 '(開始日含めて7日間なので+6)
    sHTML = sHTML & "      <th width='60'>"&oWorkSheet.Cells(initWeekDayRow, iColumn)&"</tb>" & vbCrLf
Next
sHTML = sHTML     & "    </tr>" & vbCrLf

'*** 勤務表の各メンバに対して、現在日付から一週間の勤務予定を取得、成果物HTMLに追記
'*** メンバ毎にForループ
For iRow = initMemberHeadRow To initMemberTailRow
    sHTML = sHTML     & "    <tr>" & vbCrLf
    sHTML = sHTML     & "      <td>"&oWorkSheet.Cells(iRow, initMemberColumn)&"</td>" & vbCrLf
    '*** 現在日付から一週間をForループ
    For iColumn = iStartColumn To iStartColumn + 6 '(開始日含めて7日間なので+6)
        sHTML = sHTML & "      <td>"&oWorkSheet.Cells(iRow, iColumn)&"</tb>" & vbCrLf
    Next
    sHTML = sHTML     & "    </tr>" & vbCrLf
Next

'*** 成果物HTMLの末尾を追記
sHTML = sHTML & "  </table>" & vbCrLf
sHTML = sHTML & "</body></html>" & vbCrLf

'*** 成果物HTMLをファイルとして出力
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oHtml
Set oHtml = fso.CreateTextFile(initResultFilePath)
oHtml.Write sHTML
oHtml.Close


'******************
'*** 終了処理部 ***
'******************

oWorkBook.Close(False)
AppExcel.Quit
Set AppExcel = Nothing

Set fso   = Nothing
Set oHtml = Nothing

msgbox "End of script",,"INFO"

実行してみた

スクリプトを実行すると、「手動定義部」で指定したパスに成果物であるHTMLファイルが生成される。
これをWebブラウザで開くとこんな感じになった。

うむ。
内容的には今後一週間の各メンバの勤務予定がHTMLのテーブルとして出力されている形だ。
欲を言えば土日列に色を付けたいとか、出勤とテレワークで色分けしたいとかはあるが、概ね良い感じではなかろうか。
あとはこれをタスクスケジューラで実行するなり、朝会の時にでも実行しておくなりして用意しておけば良いだろう。
ローカルでのスクリプト実行時間は約３秒程度。(勤務表がUNCパス指定であればもう少しかかるかもしれない。)
WebブラウザからHTMLファイルを開くのはもはや一瞬。
これで目的は達成された。

終わりに

今回もまたVBScriptで書いてみた。
ゆくゆくはPowershellスクリプト化した方が良いんだろうなぁとか思いつつ、なんか苦手なんだよなぁps1というところ。
まぁ自分が使う分には誰かに継承するわけでもないので良いだろう。