VBA 日次チェックシート生成

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

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

'照明チェック --------------------------------------------------------

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 Sub