シートのVBAコード
下記に変更してください。
'設定値のチェック
Private Function SetDataCheck() As Boolean
SetDataCheck = False
'開始セル位置
If Range("L4") = "" Then
Range("L4").Select
Beep
MsgBox "開始セル位置を入力してください。", , "生産予定実績表"
Exit Function
End If
If Range(Range("L4")).Column < 2 Then
Range("L4").Select
Beep
MsgBox "開始セル位置の列はB以降にしてください。", , "生産予定実績表"
Exit Function
End If
'作成年のチェック
If Range("L9") < 2000 Or Range("L9") > 2100 Then
Range("L9").Select
Beep
MsgBox "作成年を2000~2100の範囲で入力してください。", , "生産予定実績表"
Exit Function
End If
'作成月のチェック
If Range("L10") < 1 Or Range("L10") > 12 Then
Range("L10").Select
Beep
MsgBox "作成月を1~12の範囲で入力してください。", , "生産予定実績表"
Exit Function
End If
SetDataCheck = True
End Function
Private Sub ExNewSheetMake()
Dim SheetName As String
SheetName = ExNewSheetName
'シートの追加
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'名前の変更
ActiveWorkbook.ActiveSheet.Name = SheetName
End Sub
Private Sub CommandButton1_Click()
Range("L12").Select
If Not SetDataCheck Then
Exit Sub
End If
ExNewSheetMake
Worksheets("機種マスター").Select
Range("L12").Select
DaySet
End Sub
下記のVBAコードを追加してください。
'日付をセット
Private Sub DaySet()
Dim i As Integer
Dim s As String
Dim saijitu As String
Dim lastday As Integer
Dim tdate As Date
Dim ncol As Integer
Dim nrow As Integer
tdate = Format(Range("L9") & "/" & Range("L10") & "/1", "yyyy/mm/dd")
Worksheets(Sheets.Count).Select
Worksheets(Sheets.Count).Range(Range("L4")).Select
lastday = MonthLastDay(Range("L9"), Range("L10"))
For i = 1 To lastday
'国民の祝日か判定
saijitu = GetSaijituName(tdate)
If saijitu <> "" Then
'フォント色をセット
ActiveCell.Font.Color = Range("L8").Interior.Color
'祭日名のコメントを追加
ActiveCell.AddComment saijitu
ActiveCell.Comment.Visible = True
'追加したコメントを選択
Selection.Comment.Shape.Select True
'自動サイズにする
Selection.AutoSize = True
' コメントを非表示する
ActiveCell.Comment.Visible = False
Else
'曜日の取得
s = GetWeekDay(tdate)
'文字のフォント色をセット
If s = "日" Then
ActiveCell.Font.Color = Range("L7").Interior.Color
ElseIf s = "土" Then
ActiveCell.Font.Color = Range("L6").Interior.Color
Else
ActiveCell.Font.Color = Range("L5").Interior.Color
End If
End If
'中央配置
ActiveCell.HorizontalAlignment = xlHAlignCenter
ActiveCell = i & "(" & s & ")"
tdate = tdate + 1
ActiveCell.Offset(columnOffset:=1).Activate
Next
Worksheets(Sheets.Count).Range(Range("L4")).Select
End Sub
標準コード
Option Explicit
'日付の曜日を取得
Public Function GetWeekDay(tdate As Date) As String
Select Case Weekday(tdate)
Case 1
GetWeekDay = "日"
Case 2
GetWeekDay = "月"
Case 3
GetWeekDay = "火"
Case 4
GetWeekDay = "水"
Case 5
GetWeekDay = "木"
Case 6
GetWeekDay = "金"
Case 7
GetWeekDay = "土"
End Select
End Function
'国民の祝日か判定
Public Function GetSaijituName(tSrcDate As Date) As String
Dim SaiName As String
Dim tdate As Date
SaiName = ""
Select Case CLng(Format(tSrcDate, "mmdd"))
Case 101 '1948年-元日制定
If tSrcDate >= #7/20/1948# Then
SaiName = "元日"
End If
Case 108 To 114 '2000年1月第2月曜-成人の日
If tSrcDate >= #1/1/2000# Then
If Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "成人の日"
End If
End If
Case 115 '1948年~1999年-成人の日
If tSrcDate >= #7/20/1948# And tSrcDate < #1/1/2000# Then
SaiName = "成人の日"
End If
Case 116 '1948年~1999年-成人の日 振替休日
If tSrcDate >= #7/20/1948# And tSrcDate < #1/1/2000# _
And Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "振替休日"
End If
Case 211 '1967年-建国記念の日
If tSrcDate >= #6/25/1966# Then
SaiName = "建国記念の日"
End If
Case 224 '1989/2/24-大喪の礼
If tSrcDate = #2/24/1989# Then
SaiName = "大喪の礼"
End If
Case 319 To 322 '1948年-春分の日 1973年-振替休日
If tSrcDate >= #7/20/1948# Then
tdate = HaruAkiDay(Year(tSrcDate), 0)
If tdate = tSrcDate Then
SaiName = "春分の日"
ElseIf tSrcDate >= #4/12/1973# And _
(Weekday(tSrcDate, vbSunday) = vbMonday) And _
(tdate + 1 = tSrcDate) Then
SaiName = "振替休日"
End If
End If
Case 429 '1948年-天皇誕生日,1989年-みどりの日
If tSrcDate >= #2/17/1989# Then
SaiName = "みどりの日"
ElseIf tSrcDate >= #7/20/1948# Then
SaiName = "天皇誕生日"
End If
Case 503 '1948年-憲法記念日
If tSrcDate >= #7/20/1948# Then
SaiName = "憲法記念日"
End If
Case 504 '1973年-振替休日,1985年-国民の休日
Select Case Weekday(tSrcDate, vbSunday)
Case vbSunday
Case vbMonday
If tSrcDate >= #4/12/1973# Then
SaiName = "振替休日"
End If
Case Else
If tSrcDate >= #12/27/1985# Then
SaiName = "国民の休日"
End If
End Select
Case 505 '1948年-憲法記念日
If tSrcDate >= #7/20/1948# Then
SaiName = "こどもの日"
End If
Case 715 To 721 '1996年-海の日,2003年第3月曜
If tSrcDate >= #1/1/2003# Then
If Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "海の日"
End If
ElseIf tSrcDate >= #1/1/1996# And Day(tSrcDate) = 20 Then
SaiName = "海の日"
End If
Case 915 To 921 '1996年-敬老の日,2003年第3月曜
If tSrcDate >= #6/25/1966# And tSrcDate < #1/1/2003# Then
SaiName = "敬老の日"
Else
If Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "敬老の日"
End If
End If
Case 921 To 924 '1948年-秋分の日,1973年-振替休日
If tSrcDate >= #7/20/1948# Then
tdate = HaruAkiDay(Year(tSrcDate), 1)
If tdate = tSrcDate Then
SaiName = "秋分の日"
ElseIf tSrcDate >= #4/12/1973# And _
(Weekday(tSrcDate, vbSunday) = vbMonday) And _
(tdate + 1 = tSrcDate) Then
SaiName = "振替休日"
End If
End If
Case 1008 To 1014 '1966年-体育の日,2000年第2月曜
If tSrcDate >= #1/1/2000# Then
If Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "体育の日"
End If
'平成10年法律141号-[体育の日]10月10日→10月第2月曜:平成12年1月1日より
ElseIf tSrcDate >= #6/5/1966# Then
If Day(tSrcDate) = 10 Then
SaiName = "体育の日"
ElseIf Day(tSrcDate) = 11 Then '1973年-振替休日
If tSrcDate >= #4/12/1973# And _
Weekday(tSrcDate, vbMonday) = vbMonday Then
SaiName = "体育の日"
End If
End If
End If
Case 1103 '1948年-文化の日
If tSrcDate >= #7/20/1948# Then
SaiName = "文化の日"
End If
Case 1123 '1948年-勤労感謝の日
If tSrcDate >= #7/20/1948# Then
SaiName = "勤労感謝の日"
End If
Case 1223 '1989年-天皇誕生日
If tSrcDate >= #2/17/1989# Then
SaiName = "天皇誕生日"
End If
Case 102, 212, 430, 506, 721, 916, 1104, 1124, 1224 '1973年-振替休日
If tSrcDate >= #4/12/1973# And Weekday(tSrcDate, vbSunday) = vbMonday Then
SaiName = "振替休日"
End If
Case Else
SaiName = ""
End Select
GetSaijituName = SaiName
End Function
'春分の日,秋分の日
Public Function HaruAkiDay(ByVal yy As Integer, haru As Integer) As Date
Dim vv As Variant
Dim yr As Variant
Dim mo As Integer
Dim dy As Integer
If 1980 <= yy And yy <= 2099 Then
yr = CDec(yy - 1980)
If haru = 0 Then '春分の日
mo = 3
vv = CDec("20.8431")
Else '秋分の日
mo = 9
vv = CDec("23.2488")
End If
dy = CLng(Int(vv + CDec(0.242194) * yr - Int(yr / CDec(4))))
HaruAkiDay = DateSerial(yy, mo, dy)
Else
HaruAkiDay = CDate(0)
End If
End Function
'月の末日を取得
Public Function MonthLastDay(yy As Integer, mm As Integer) As Integer
Dim i As Integer
Dim tdate As Date
tdate = Format(yy & "/" & mm & "/1", "yyyy/mm/dd")
i = 28
Do
i = i + 1
Loop Until Day(tdate + i - 1) = 1
MonthLastDay = i - 1
End Function
シート画面
「作成開始ボタン」をクリックすると、「日付(曜日)」の形式でセットされます。
土曜、日曜、祭日の色は指定色になります。
祭日は下図のように祝日名をコメントで表示します。