毎月第一日曜と第一月曜の時のみ塗りつぶす方法

質問

Sub 印刷()
'
' Macro1 Macro
' マクロ記録日 : 201X/X/X ユーザー名 : AAAA
'
'
If MsgBox("実行する場合はＯＫ、間違ってこのボタンをクリックした場合はキャンセルをクリックしてください。(日付確認後、印刷のこと。)", vbOKCancel) = vbCancel Then
End

End If

'A印刷
ChDir "L:\フォルダB\X\新規"
Workbooks.Open Filename:="L:\フォルダB\X\新規\記録表\工程分析.xls"
Sheets("日曜日印刷").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("月曜日印刷").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Save
ActiveWindow.Close

「日曜日印刷」「月曜日印刷」各シートのAU２５には＝TODAY（）が入力されています。

質問ですが各シートのAU25の日付が第一日曜日の時は「日曜日印刷」シートのCK48とAJ96のセルが塗りつぶされて、AU25の日付が第一月曜日の時は「月曜日印刷」シートのCK52とAV96が塗りつぶされる方法はどのようにしたら良いでしょうか？

回答No.3

kkkkkm · ベストアンサー

> 「日曜日印刷」「月曜日印刷」が選択された場合はどの様にすれば良いのでしょうか？

日付のあるセルは多分AU25ではなくK1になるのかとも思いますが、一応質問時のAU25にしてますので適宜変更してください。また、BOMonthの取り出し方も変更してます。

Sub 印刷()
Dim PrintSheetName As String
Dim BOMonth As Date

If MsgBox("実行する場合はＯＫ、間違ってこのボタンをクリックした場合はキャンセルをクリックしてください。(日付確認後、印刷のこと。)", vbOKCancel) = vbCancel Then
Exit Sub
End If
' A印刷
ChDir "L:\フォルダB\X\新規"
Workbooks.Open Filename:="L:\フォルダB\X\新規\記録表\工程分析.xls"
Sheets("毎日印刷").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
PrintSheetName = Format(Range("K1").Value2, "aaaa") & "印刷"
BOMonth = Format(Range("AU25").Value2, "yyyy/mm/1")
Sheets(PrintSheetName).Select
If PrintSheetName = "日曜日印刷" Then
With Sheets("日曜日印刷")
If Range("AU25") = BOMonth - Weekday(BOMonth - 1) + 7 Then
.Range("CK48").Interior.ColorIndex = 4
.Range("AJ96").Interior.ColorIndex = 4
Else
.Range("CK48").Interior.ColorIndex = xlNone
.Range("AJ96").Interior.ColorIndex = xlNone
End If
End With
ElseIf PrintSheetName = "月曜日印刷" Then
With Sheets("月曜日印刷")
If Range("AU25") = BOMonth - Weekday(BOMonth - 2) + 7 Then
.Range("CK52").Interior.ColorIndex = 4
.Range("AV96").Interior.ColorIndex = 4
Else
.Range("CK52").Interior.ColorIndex = xlNone
.Range("AV96").Interior.ColorIndex = xlNone
End If
End With
End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

お礼

この度はありがとうございました。
非常に助かりました。

回答No.2

kkkkkm

No1の訂正です。
No1だと該当曜日以降は塗りつぶしっぱなしになりますので該当曜日以外は塗りつぶしなしにしなければいけないような気もしたので以下のように変更してください。

Sheets("日曜日印刷").Select
With Sheets("日曜日印刷")
If Range("AU25") = BOMonth - Weekday(BOMonth - 1) + 7 Then
.Range("CK48").Interior.ColorIndex = 4
.Range("AJ96").Interior.ColorIndex = 4
Else
.Range("CK48").Interior.ColorIndex = xlNone
.Range("AJ96").Interior.ColorIndex = xlNone
End If
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("月曜日印刷").Select
With Sheets("月曜日印刷")
If Range("AU25") = BOMonth - Weekday(BOMonth - 2) + 7 Then
.Range("CK52").Interior.ColorIndex = 4
.Range("AV96").Interior.ColorIndex = 4
Else
.Range("CK52").Interior.ColorIndex = xlNone
.Range("AV96").Interior.ColorIndex = xlNone
End If
End With

お礼

この度はありがとうございました。
非常に助かりました。

補足

いつもありごとうございます。勉強になります。
以前回答して頂いた
Sub 印刷()
Dim PrintSheetName As String

If MsgBox("実行する場合はＯＫ、間違ってこのボタンをクリックした場合はキャンセルをクリックしてください。(日付確認後、印刷のこと。)", vbOKCancel) = vbCancel Then
Exit Sub
End If
' A印刷
ChDir "L:\フォルダB\X\新規"
Workbooks.Open Filename:="L:\フォルダB\X\新規\記録表\工程分析.xls"
Sheets("毎日印刷").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
PrintSheetName = Format(Range("K1").Value, "aaaa") & "印刷"
Sheets(PrintSheetName).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
このVBAでPrintSheetName = Format(Range("K1").Value, "aaaa") & "印刷"
で選択されたシートが「日曜日印刷」「月曜日印刷」が選択された場合はどの様にすれば良いのでしょうか？

回答No.1

kkkkkm

以下のような感じでいかがですか。どこのタイミングで色を付けるのかわからなかったのでシートが選択された後に色を塗ることにしています。
また、色番号は以下のページを参考にするか
http://www.relief.jp/itnote/archives/000482.php
マクロの記録でセルを塗りつぶしてそのコードを入れ込んでください。

Sub 印刷()
Dim BOMonth As Date

BOMonth = Year(Range("AU25").Value2) & "/" & Month(Range("AU25").Value2) & "/" & "1"
'中略
'A印刷
ChDir "L:\フォルダB\X\新規"
Workbooks.Open Filename:="L:\フォルダB\X\新規\記録表\工程分析.xls"
Sheets("日曜日印刷").Select
If Range("AU25") = BOMonth - Weekday(BOMonth - 1) + 7 Then
With Sheets("日曜日印刷")
.Range("CK48").Interior.ColorIndex = 4
.Range("AJ96").Interior.ColorIndex = 4
End With
End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("月曜日印刷").Select
If Range("AU25") = BOMonth - Weekday(BOMonth - 2) + 7 Then
With Sheets("月曜日印刷")
.Range("CK52").Interior.ColorIndex = 4
.Range("AV96").Interior.ColorIndex = 4
End With
End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Save
ActiveWindow.Close

お礼

この度はありがとうございました。
非常に助かりました。