改ページのタイミングと同時に罫線が引けないかと思い、試作版を作ってみた。
Excel2002で動作した。
なお、以下の改良すべき点があり
・レスポンスが遅い → For文のStep句を利用したほうがよいかも
・最終行の取得が正確ではない(理由はSpecialCellsメソッドの仕様による)
・一定の行になったら罫線を引くのではなく、行幅まで考慮したほうが正確
・定数がカッコ悪い
AutoBorderSetting.vbs
'--------------------------------------------------------------------------------------
'
' Excel 罫線設定スクリプト
' (指定したフォルダにあるExcelファイルの罫線をセットする)
'
' 注意点 スクリプト実行前にすべてのExcelアプリケーションを終了してください。
' スクリプト実行中はマウス、キーボードを使用しないでください。
' このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください。
'
' ※SpecialCellsでの最終行の取得は以下の欠点がある点に注意すること
' ・値の入力されている最終行ではなく、設定のされている最終行を取得する。
' 例えば、値の入力はなく行の幅を変更しただけでもその行が最終行とみなされる
'--------------------------------------------------------------------------------------
targetPath = InputBox("罫線を設定するディレクトリを入力","ディレクトリの指定","")
if targetPath = "" then
msgbox "設定を中止しました。"
else
'Excel定数の定義 (参照が分んなかったのでここに記述)
xlCellTypeLastCell = 11
xlEdgeBottom = 9
xlContinuous = 1
xlMedium = -4138
xlAutomatic = -4105
'このディレクトリのファイル一覧を取得する
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set targetFolder = fileSystem.getFolder(targetPath)
Set fileList = targetFolder.Files
'ファイルの終端までループ
For Each wkFile In fileList
'対象ファイルがExcelならExcelで開く
if wkFile.type = "Microsoft Excel ワークシート" then
Set Excel = CreateObject("Excel.Application")
Set wkBook = Excel.WorkBooks.Open(wkFile)
'シートの数ループする
For i = 1 to wkBook.WorkSheets.Count
Set xlsSheet = wkBook.WorkSheets(i)
'最終行とカラムを取得する
lastColoum = xlsSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
lastRow = xlsSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'行のループ
For row = 0 To lastRow
'先頭行は出力しない
if row = 0 then
'55行ごとに罫線を出力 (最終行には常に出力)
elseif row mod 55 = 0 or row = lastRow then
'カラムのループ
For col = 1 To lastColoum
With xlsSheet.Cells(row, col).Borders(xlEdgeBottom) '下線
.LineStyle = xlContinuous '実線
.Weight = xlMedium '太さ(中?)
.ColorIndex = xlAutomatic '色(自動)
End With
Next
end if
Next
Next
Excel.Visible = true
'Excelを終了する。
wkBook.Save
wkBook.Close
Excel.Quit
end if
Next
msgbox "設定を完了しました。"
end if
