【カレンダーの休日を条件付き書式設定で網掛けにする】【エクセル2013,VBA】
チェック表や予約表をエクセルで毎月作成しプリントアウトして使用しているケース多いと思います。毎月手作業で、網掛けにしたり書式を変えたチェック表や予約表の作成を行っている人をみかけると条件付き書式設定が便利ですよと教えてあげたくなるのだけど、その説明が面倒です。加えて、一ヶ月が短い月の表示の対応だとか、会社の休日の対応だとか当然出てくる要望に対処していくと、どんどん説明が面倒になります。なので、しばらくはこちらでファイルをもらって条件付き書式設定してあげるのですが、数が多くなってくると縦・横・分割様々なタイプの表がくるし、時々修正などの要望も入るので、やはり対応が面倒なので自動化をこころみてみました。
ダイアログボックスからの入力だけで、もらったカレンダーの書式設定が簡単にできるコードを書いてみました。
設定の流れ
1.年をリストボックスで表示するセルを選択(初期値A1)
Office TANAKA - Excel VBA Tips[実は奥が深いInputBox]
（inputboxで範囲を指定）
2.月をリストボックスで表示するセルを選択(初期値B1)
別のシートでも可（複数シートの表示月を連動させたい場合はどこか一箇所をしていすればよい）
3.開始日を入力（初期値1)
16日スタートなども可。表が分割されているようなケースに使う。
4.休日リスト（土日以外の休日。祝日含む）を別シートに用意し、その範囲を指定する（なくても可）。
祝日リストはネットにころがっているので入手し会社の休日があればそれに付け加える。
5.条件付き書式設定したい範囲を指定する。
6.表の方向を指定する（縦or横）
選択した方向に応じ、1行or1列目に日付を表示する数式がセルに入力される。
最初のセルの数式は「=Date(年,月,開始日)」のシリアル値とし、
Range(XXX).NumberFormatLocal = "d""(""aaa"")"とすることで日にちと曜日のみを表示する。
DATE関数の使い方 初心者のエクセル(Excel)学習・入門
6.5 文字の表示形式に関する書式設定 - Excel VBA Tips
1行or1列目の数式を以下のように設定
「=IF(INDIRECT(""R[-1]C"",FALSE)="""","""",IF(DAY(INDIRECT(""R[-1]C"",FALSE)+1)=1,"""",INDIRECT(""R[-1]C"",FALSE)+1))」
相対位置を参照する～ExcelでのINDIRECTのすすめ～：システム開発メモ：So-netブログ
選択された範囲に条件付き書式が設定される。
土曜日→青の網掛け
日曜日、休日→赤の網掛
テーマカラーでセルの網かけに色を付ける - PatternThemeColorとPatternTintAndShadeプロパティ - Excel VBA Tips
Excel(エクセル)基本講座：条件付き書式で土日に色を付ける
参考
エクセルExcel大事典 VBAマクロ 日付関数 DateAdd DateDiff DatePart DateSerial Timer
=============================================================
Sub 書式設定()
On Error GoTo ELH
Dim YCell As String, Mcell As String, YList As String, buf As Range, StartC As String, StartR As Long, StartD As Long, i As Long, RCType As String, tst As String, Arr(1 To 4) As Variant
'初期設定値(繰り返し同じ範囲を指定するなら、ここを書き換えておく）
Arr(1) = "$A$1" '年を表示するセル
Arr(2) = "$B$1" '月を表示するセル
Arr(3) = "" '休日リスト範囲例：Sheet1!$A1:$A$100
Arr(4) = "$B$5:$F$34" '条件付書式を設定する範囲
Set buf = Application.InputBox(PROMPT:="年を表示するセルを選択", Type:=8, Default:=Arr(1)) '年を表示するセルを選択
YCell = buf.Worksheet.Name & "!" & buf.Address
buf(1).Select
buf(1) = Year(Date) '初期値＝今年
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Year(Date) & "," & Year(Date) + 1 & "," & Year(Date) + 2 '3年分
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Set buf = Application.InputBox(PROMPT:="月を表示するセルを選択", Type:=8, Default:=Arr(2)) '月を表示するセルを選択
Mcell = buf.Worksheet.Name & "!" & buf.Address
buf(1).Select
buf(1) = Month(Date) '初期値＝今月
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="1,2,3,4,5,6,7,8,9,10,11,12"
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
StartD = InputBox("カレンダーの開始日を入力", "入力", 1) '開始日を入力
If MsgBox("休日リストを使用しますか？", vbYesNo) = vbYes Then '休日リストの設定。リストはシリアル値で。休日を追加する予定なら広めに指定しておけばよい
Set buf = Application.InputBox(PROMPT:="休日リストが表示されている範囲を選択", Type:=8, Default:=Arr(3))
YList = buf.Worksheet.Name & "!" & buf.Address
Else
YList = ""
End If
Set buf = Application.InputBox(PROMPT:="条件付書式を設定したい範囲を選択", Type:=8, Default:=Arr(4)) '条件付書式を設定したい範囲を選択
Sheets(buf.Worksheet.Name).Select
buf.Select
StartC = Mid(buf(1).Address, 2, InStr(2, buf(1).Address, "$") - 2)
StartR = buf(1).Row
'最初のセルに年と月と開始日からシリアル値を返す数式を入力。表示は日付と曜日のみ。
buf(1) = "=Date(" & YCell & "," & Mcell & "," & StartD & ")"
buf(1).NumberFormatLocal = "d""(""aaa"")"""
RCType = MsgBox("日付の記載方向。" & Chr(13) & "縦方向なら→はい。横方向なら→いいえ。", vbYesNo)
If RCType = 7 Then '横の場合
tst1 = ""
tst2 = "$"
RangeST = tst1 & StartC & tst2 & StartR
'1行目に日付の表示。シリアル値。表示は日付と曜日のみ。
Range(Cells(buf(1).Row, buf(1).Column + 1), Cells(buf(1).Row, buf(buf.Count).Column)) = "=IF(INDIRECT(""RC[-1]"",FALSE)="""","""",IF(DAY(INDIRECT(""RC[-1]"",FALSE)+1)=1,"""",INDIRECT(""RC[-1]"",FALSE)+1))"
Range(Cells(buf(1).Row, buf(1).Column + 1), Cells(buf(1).Row, buf(buf.Count).Column)).NumberFormatLocal = "d""(""aaa"")"""
Else '縦の場合
tst1 = "$"
tst2 = ""
RangeST = tst1 & StartC & tst2 & StartR
'1列目に日付の表示。シリアル値。表示は日付と曜日のみ。
Range(Cells(buf(1).Row + 1, buf(1).Column), Cells(buf(buf.Count).Row, buf(1).Column)) = "=IF(INDIRECT(""R[-1]C"",FALSE)="""","""",IF(DAY(INDIRECT(""R[-1]C"",FALSE)+1)=1,"""",INDIRECT(""R[-1]C"",FALSE)+1))"
Range(Cells(buf(1).Row + 1, buf(1).Column), Cells(buf(buf.Count).Row, buf(1).Column)).NumberFormatLocal = "d""(""aaa"")"""
End If
tst = "=Weekday(" & RangeST & ")=1"
Call SelectionFormat1(255, tst) '日曜日の条件付書式設定。
tst = "=Weekday(" & RangeST & ")=7"
Call SelectionFormat1(15773696, tst) '土曜日の条件付書式設定
If YList <> "" Then '休日リストを使用する場合
tst = "=COUNTIF(" & YList & "," & RangeST & ")>0" 'countifで休日かどうか判断
Call SelectionFormat1(255, tst) '休日の条件付書式設定
End If
Exit Sub
ELH:
MsgBox "終了です。"
End Sub
Sub SelectionFormat1(ColorNo As Long, tst As String)
'条件付書式設定。網掛けの色(ColorNo)と条件式(tst)を引数としている。
Selection.FormatConditions.Add Type:=xlExpression, Formula1:=tst
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Pattern = xlGray8
.PatternColor = ColorNo
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
