Function holiday_chk(dt)
'通常の休日
If Weekday(dt) = 1 Or Weekday(dt) = 7 Then
holiday_chk = True
Exit Function
End If
'祝日
For r = 3 To 30
If Sheets("表紙").Cells(r, 4).Value = dt Then
holiday_chk = True
Exit Function
End If
Next r
holiday_chk = False
End Function
Private Sub CommandButton1_Click()
'入力チェック --------------------------------------------------------
If IsDate(Sheets("表紙").Cells(3, 2).Value) = False Then
MsgBox "開始日が日付ではありません。"
Exit Sub
End If
If IsDate(Sheets("表紙").Cells(6, 2).Value) = False Then
MsgBox "終了日が日付ではありません。"
Exit Sub
End If
If Sheets("表紙").Cells(3, 2).Value >= Sheets("表紙").Cells(6, 2).Value Then
MsgBox "開始日と終了日の関係が正しくありません。"
Exit Sub
End If
'ゴミ分別 --------------------------------------------------------
Sheets("ゴミ分別原本(雛形)").Copy after:=Sheets("表紙")
Set g = ActiveSheet
r = 7
dt = Sheets("表紙").Cells(3, 2).Value
Do While dt <= Sheets("表紙").Cells(6, 2).Value
f = holiday_chk(dt)
'表示形式
If r = 7 Then
g.Cells(r, 1).NumberFormatLocal = "yyyy/mm/dd"
Else
g.Cells(r, 1).NumberFormatLocal = "mm/dd"
End If
g.Cells(r, 3).NumberFormatLocal = "aaa"
'配置
g.Cells(r, 5).HorizontalAlignment = xlCenter
g.Cells(r, 6).HorizontalAlignment = xlCenter
g.Cells(r, 7).HorizontalAlignment = xlCenter
g.Cells(r, 9).HorizontalAlignment = xlCenter
'休日の場合
If f = True Then g.Range(g.Cells(r, 1), g.Cells(r, 9)).Interior.Color = RGB(222, 222, 222)
'罫線
g.Range(g.Cells(r, 1), g.Cells(r, 9)).Borders.LineStyle = True
'値
g.Cells(r, 1).Value = dt '日付
g.Cells(r, 3).Value = dt '曜日
'休日では無い場合
If f = False Then
g.Cells(r, 5).Value = "○" '一般廃棄物ゴミ
g.Cells(r, 6).Value = "○" '廃プラスチック類
g.Cells(r, 7).Value = "○" '金属くず
g.Cells(r, 8).Value = "" '備考
tmp = Int((15 - 9 + 1) * Rnd + 9)
g.Cells(r, 9).Value = Sheets("表紙").Cells(tmp, 2).Value 'チェック者
End If
r = r + 1
dt = DateAdd("d", 1, dt)
Loop
'表題
g.Cells(2, 1).Value = " ▼" & Sheets("表紙").Cells(18, 2).Value & "年廃棄物分別チェック表"
'作成日
For Each sh In g.Shapes
If sh.Type = msoTextBox Then
If sh.TextFrame.Characters.Text = "x" Then
sh.TextFrame.Characters.Text = "作成日 " & Sheets("表紙").Cells(21, 2).Value
End If
End If
Next
'照明チェック --------------------------------------------------------
Sheets("照明チェック(雛形)").Copy after:=Sheets("表紙")
Set s = ActiveSheet
r = 9
dt = Sheets("表紙").Cells(3, 2).Value
Do While dt <= Sheets("表紙").Cells(6, 2).Value
f = holiday_chk(dt)
'表示形式
If r = 9 Then
s.Cells(r, 1).NumberFormatLocal = "yyyy/mm/dd"
Else
s.Cells(r, 1).NumberFormatLocal = "mm/dd"
End If
s.Cells(r, 3).NumberFormatLocal = "aaa"
'配置
s.Cells(r, 5).HorizontalAlignment = xlCenter
s.Cells(r, 6).HorizontalAlignment = xlCenter
s.Cells(r, 7).HorizontalAlignment = xlCenter
s.Cells(r, 8).HorizontalAlignment = xlCenter
s.Cells(r, 9).HorizontalAlignment = xlCenter
s.Cells(r, 11).HorizontalAlignment = xlCenter
'休日の場合
If f = True Then s.Range(s.Cells(r, 1), s.Cells(r, 11)).Interior.Color = RGB(222, 222, 222)
'罫線
s.Range(s.Cells(r, 1), s.Cells(r, 11)).Borders.LineStyle = True
'値
s.Cells(r, 1).Value = dt '日付
s.Cells(r, 3).Value = dt '曜日
'休日では無い場合
If f = False Then
s.Cells(r, 5).Value = "○" '照明
s.Cells(r, 6).Value = "○" '空調
s.Cells(r, 7).Value = "○" 'マシン
s.Cells(r, 8).Value = "○" 'ディスプレイ
s.Cells(r, 9).Value = "○" 'プリンタ
tmp = Int((15 - 9 + 1) * Rnd + 9)
s.Cells(r, 11).Value = Sheets("表紙").Cells(tmp, 2).Value 'チェック者
End If
r = r + 1
dt = DateAdd("d", 1, dt)
Loop
'表題
s.Cells(2, 1).Value = " ▼" & Sheets("表紙").Cells(18, 2).Value & "年省エネチェック表"
'作成日
For Each sh In s.Shapes
If sh.Type = msoTextBox Then
If sh.TextFrame.Characters.Text = "x" Then
sh.TextFrame.Characters.Text = "作成日 " & Sheets("表紙").Cells(21, 2).Value
End If
End If
Next
End Sub