本記事では、Windows 専用の業務効率化ツールである本ツールの仕様と操作方法について紹介します。
ツールの種別は以下となります。
このツールは、Windows 専用の業務効率化ツールです。HTA の特性により、HTML で画面を構築しつつ、VBScriptを
用いた操作制御が可能になっています。動作環境は以下となります。
ツールは Windows 10 および Windows 11 を前提に作られおり動作検証済みです。画面仕様は以下となります。
・ツールの画面サイズは横幅 954px、高さおよそ 1000px に固定されており、ユーザーはリサイズできず、
最大化もできません。解像度が低い環境では、画面の一部がはみ出す可能性があります。
・マスター情報から対象サーバーIDとサーバー名を取得する実行結果を表示させるだけでなく、Excelに出力して
保存してくれるところまでを行ってくれます。
・今回は実機環境作業申請書のみ機能となり、メール作成また持ち込み資材は対象外となりますのでご了承ください。
・VBscriptだけの利用はできないため、HTAのコードに関しては「タブメニューのウィンドウ④(前編)」を事前に準備しておいてください。
Option Explicit
' コマンドライン引数を受け取るための変数を準備
Dim args, tabName
'======================================================================================================
' (引数)：参照元また出力元のExcelのパスや申請日や作業者名を格納する変数の準備
'======================================================================================================
Dim vbs_setDateStr, vbs_shinseiUser_furigana, vbs_ShinseiUser, vbs_ShinseiName2, vbs_WorkStartDate, vbs_workEndDate, vbs_BasePath, vbs_SrcPath, vbs_OutPath
'======================================================================================================
' 準備した変数に引数を格納
'======================================================================================================
' コマンドライン引数を受け取る
Set args = WScript.Arguments
If args.Count >= 10 Then
tabName = CStr(args(0))
vbs_setDateStr = CStr(args(1))
vbs_shinseiUser_furigana = CStr(args(2))
vbs_ShinseiUser = CStr(args(3))
vbs_ShinseiName2 = CStr(args(4))
vbs_WorkStartDate = CStr(args(5))
vbs_workEndDate = CStr(args(6))
vbs_BasePath = CStr(args(7))
vbs_SrcPath = CStr(args(8))
vbs_OutPath = CStr(args(9))
Else
MsgBox "引数が不足しています。", vbExclamation
WScript.Quit
End If
' タブごとの処理
Select Case LCase(Trim(tabName))
Case "tab1"
'======================================================================================================
' 変数の設定
'======================================================================================
Dim xlApp, srcBook, srcSheet, outBook, outSheet
Dim rawText, onlyNum, ch, idx
Dim NodeID, NodeName
Dim targetDate, dataStartRow, lastRow, outRow, r, hitcount
Dim targetText, i
Dim startCopyRow, pasteRow, copyRange, pasteRange, j, arr(5)
'======================================================================================
' 参照元と出力先のファイルの指定してファイルを開く
'======================================================================================
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.DisplayAlerts = False
Set srcBook = xlApp.Workbooks.Open(vbs_SrcPath)
Set srcSheet = srcBook.Sheets(1)
Set outBook = xlApp.Workbooks.Open(vbs_OutPath)
'======================================================================================
' 表紙の処理
'======================================================================================
Set outSheet = outBook.Sheets(1)
' 4列目（D列）7～10行に格納
outSheet.Cells(7, 4).Value = vbs_setDateStr
outSheet.Cells(8, 4).Value = vbs_ShinseiUser
outSheet.Cells(9, 4).Value = vbs_WorkStartDate
outSheet.Cells(10, 4).Value = vbs_workEndDate
outSheet.Cells(14, 4).Value = vbs_WorkStartDate
outSheet.Cells(15, 4).Value = vbs_workEndDate
' 左寄せ（D7～D10）
outSheet.Range("D7:D10").HorizontalAlignment = -4131
outSheet.Range("D13:D15").HorizontalAlignment = -4131
'======================================================================================
' 改定履歴の処理
'======================================================================================
Set outSheet = outBook.Sheets(2)
' 4行目・2列目（B4）に文字列をセット
outSheet.Cells(4, 2).Value = vbs_setDateStr
outSheet.Cells(4, 4).Value = vbs_setDateStr
outSheet.Cells(4, 5).Value = vbs_ShinseiName2
outSheet.Cells(4, 6).Value = vbs_setDateStr
' 中央揃え
outSheet.Cells(4, 2).HorizontalAlignment = -4108
outSheet.Cells(4, 4).HorizontalAlignment = -4108
outSheet.Cells(4, 6).HorizontalAlignment = -4108
'======================================================================================
'「作業手続き申請書」(シート名)でオートフィルタの設定を確認する
'======================================================================================
Const xlCellTypeVisible = 12
Const xlUp = -4162
dataStartRow = 4
If srcSheet.AutoFilterMode = False Then
MsgBox "オートフィルタが設定されていません。"
srcBook.Close False
outBook.Close False
xlApp.Quit
WScript.Quit
End If
' サンプルコードのための動作確認のためフィルタリングの日付を「2025/12/25」を固定化
targetDate = vbs_WorkStartDate
srcSheet.Range("A4").AutoFilter 7, "*" & targetDate & "*"
On Error Resume Next
srcSheet.Range("G4:G41").SpecialCells xlCellTypeVisible
If Err.Number <> 0 Then
MsgBox "対象日付のデータがありません。"
Err.Clear
srcBook.Close False
outBook.Close False
xlApp.Quit
WScript.Quit
End If
On Error GoTo 0
lastRow = srcSheet.Cells(srcSheet.Rows.Count, "G").End(xlUp).Row
'======================================================================================
'申請者のふりがなと漢字を入力
'======================================================================================
Set outSheet = outBook.Sheets(3)
outSheet.Cells(18, "F").Value = vbs_shinseiUser_furigana
outSheet.Cells(19, "F").Value = vbs_shinseiUser
'======================================================================================
' 参照元ファイルのC列から出力先ファイルのH列に出力する処理
'======================================================================================
hitcount = 0
outRow = 30
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
NodeID = srcSheet.Cells(r, "C").Value
NodeName = srcSheet.Cells(r, "C").Value
'H列にサーバー管理番号を出力
outSheet.Cells(outRow, "H").Value = NodeID
'M列にサーバー名を出力
outSheet.Cells(outRow, "M").Value = NodeName
' R結合セルの書式を「数値」にする（VBScript）
With outSheet.Cells(outRow, "R")
If .MergeCells = True Then
.NumberFormat = "0"
End If
End With
'X列に「作業実施日/開始時間」を出力
rawText = CStr(srcSheet.Cells(r, "G").Value)
onlyNum = ""
For idx = 1 To Len(rawText)
ch = Mid(rawText, idx, 1)
If ch >= "0" And ch <= "9" Then
onlyNum = onlyNum & ch
End If
Next
' YYYYMMDD の先頭8桁だけ使用
outSheet.Cells(outRow, "R").Value = Left(onlyNum, 8)
outSheet.Cells(outRow+1, "R").Value = "9時00分"
' 修正後
WScript.Echo vbs_setDateStr & "|" & vbs_WorkStartDate & "|" & NodeID & "|" & NodeName
outRow = outRow + 2
hitcount = hitcount + 1
End If
End If
Next
'======================================================================================
' 参照元ファイルのD列から出力先ファイルのH列に出力処理（C列の続き）
'======================================================================================
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
NodeID = srcSheet.Cells(r, "D").Value
NodeName = srcSheet.Cells(r, "D").Value
'H列にサーバー管理番号を出力
outSheet.Cells(outRow, "H").Value = NodeID
'M列にサーバー名を出力
outSheet.Cells(outRow, "M").Value = NodeName
' R結合セルの書式を「数値」にする（VBScript）
With outSheet.Cells(outRow, "X")
If .MergeCells = True Then
.NumberFormat = "0"
End If
End With
'X列に「作業実施日/終了時間」を出力
rawText = CStr(srcSheet.Cells(r, "G").Value)
onlyNum = ""
For idx = 1 To Len(rawText)
ch = Mid(rawText, idx, 1)
If ch >= "0" And ch <= "9" Then
onlyNum = onlyNum & ch
End If
Next
' YYYYMMDD の先頭8桁だけ使用
outSheet.Cells(outRow, "X").Value = Left(onlyNum, 8)
outSheet.Cells(outRow+1, "X").Value = "15時00分"
' 修正後
WScript.Echo vbs_setDateStr & "|" & vbs_WorkStartDate & "|" & NodeID & "|" & NodeName
outRow = outRow + 2
hitcount = hitcount + 1
End If
End If
Next
'======================================================================================
' コピーして挿入する行の処理
'======================================================================================
targetText = "１．現在設定されている監視対象となっている"
lastRow = outSheet.Cells(outSheet.Rows.Count, "D").End(xlUp).Row
For r = 83 To lastRow
If InStr(outSheet.Cells(r, "D").Value, targetText) > 0 Then
startCopyRow = r
Exit For
End If
Next
hitcount = hitcount / 2 ' 整数除算（小数切り捨て）
For i = 1 To 7
Select Case i
Case 1
startCopyRow = startCopyRow + 2
arr(i-1) = startCopyRow
Case 2
startCopyRow = startCopyRow + pasteRow + 8
arr(i-1) = startCopyRow
Case 3
startCopyRow = startCopyRow + 4
arr(i-1) = startCopyRow
Case 5
startCopyRow = startCopyRow + 10
arr(i-2) = startCopyRow
Case 6
startCopyRow = startCopyRow + 8
arr(i-2) = startCopyRow
Case 7
startCopyRow = startCopyRow + 4
arr(i-2) = startCopyRow
Case Else
startCopyRow = startCopyRow - pasteRow
End Select
If i <> 4 Then
For j = 1 To hitcount - 1
outSheet.Rows(startCopyRow).Insert
startCopyRow = startCopyRow + 1
Next
End If
Next
'======================================================================================
' 取得データを出力
'======================================================================================
For i = 1 To 7
Select Case i
Case 1
startCopyRow = arr(i-1)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 2
startCopyRow = arr(i-1)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 3
startCopyRow = arr(i-1)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 5
startCopyRow = arr(i-2)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 6
startCopyRow = arr(i-2)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 7
startCopyRow = arr(i-2)
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
End Select
Next
'======================================================================================================================
' Excel保存
'======================================================================================================================
srcBook.Close False
outBook.Save
outBook.Close
xlApp.Quit
Case "tab2"
MsgBox "外部VBSで Tab2 処理を実行しました", vbInformation, "VBS処理"
Case "tab3"
MsgBox "外部VBSで Tab3 処理を実行しました", vbInformation, "VBS処理"
Case Else
MsgBox "不明なタブ: " & tabName, vbExclamation, "VBS処理"
End Select
