土曜・日曜・祝日に罫線を引く ＶＢＡ

質問

条件付き書式を使い、土曜・日曜・祝日に自動的にB列～Ｎ列までセルに色がつくように設定してあります。

（例：セルの色は省略）
Ｂ行（日付）　Ｃ行（曜日）・・・・・・・・・・Ｎ行
　　1　　　　　　　　　日
　　2　　　　　　　　　月
　　3　　　　　　　　　火
　　4　　　　　　　　　水
　　5　　　　　　　　　木
　　6　　　　　　　　　金
　　7　　　　　　　　　土
　　8　　　　　　　　　日
　　・　　　　　　　　　 ・
　　・　　　　　　　　　 ・
　　・　　　　　　　　　 ・
　 31　 　　　　　 　火

色がついたセル(土・日・祝)のＢ列～Ｎ列に、セルの真ん中を通るような赤い線をマクロを使って引きたいと思っています。そういったことは可能でしょうか？
よろしくお願いいたします。

回答No.5

watabe007 · ベストアンサー

>祝日は、違うシートに書き出して、条件に=COUNTIF(シート名!$B$2:$B$72,$A6)=1
>（Ｂ２：Ｂ７２まで祝日等のデータあり）を入れています。

Dim c As Range
'前回の直線を削除
ActiveSheet.Lines.Delete
For Each c In Range("B6:B36")
　　If Weekday(c.Offset(, -1).Value) = 7 Or _
　　　　　　Weekday(c.Offset(, -1).Value) = 1 Or _
　　　　　　Application.CountIf(Worksheets("シート名").Range("B2:B72"), c.Offset(, -1)) = 1 Then
　　　　With ActiveSheet.Shapes.AddLine(c.Left, c.Top + c.Height / 2, c.Offset(, 13).Left, c.Top + c.Height / 2)
　　　　　　.Line.ForeColor.SchemeColor = 10
　　　　End With
　　End If
Next

お礼

何度も何度も助けていただきありがとうございます。
参考にして、勉強させていただきます。

回答No.4

watabe007

>条件付き書式には、
>=WEEKDAY($A6)=7や=WEEKDAY($A6)=1 などが入っているのですが、
>（Ａ６からＡ３６までに2013/12/28などの情報があります）この式を直接入れてしまってよろしいのでしょうか？

Dim c As Range
'前回の直線を削除
ActiveSheet.Lines.Delete
For Each c In Range("B6:B36")
　　If Weekday(c.Offset(, -1).Value) = 7 Or Weekday(c.Offset(, -1).Value) = 1 Then
　　　　With ActiveSheet.Shapes.AddLine(c.Left, c.Top + c.Height / 2, c.Offset(, 13).Left, c.Top + c.Height / 2)
　　　　　　.Line.ForeColor.SchemeColor = 10
　　　　End With
　　End If
Next

If Weekday(c.Offset(, -1).Value) = 7 Or Weekday(c.Offset(, -1).Value) = 1 Then
これに祝日の判定を加える必要がありますが
祝日の判定は、どのようにされていますか

お礼

ご回答ありがとうございます。

補足

お世話になります。

祝日は、違うシートに書き出して、条件に=COUNTIF(シート名!$B$2:$B$72,$A6)=1（Ｂ２：Ｂ７２まで祝日等のデータあり）を入れています。

回答No.3

tom04

こんばんは！
横からお邪魔します。
オートシェイプを挿入するマクロはNo.1さんが的確なコードを載せていらっしゃいますので・・・

もしお使いのExcelが2010以降のバージョンであれば
「DisplayFormatオブジェクト」というものが追加されているようですので、
条件付き書式で色がついているセルを判別できます。

おそらく、月が変わるたびにマクロを実行する必要があると思いますので、
一旦オートシェイプを削除する必要あるのでは？

余計なお世話かもしれませんが・・・

Dim myShp As Object
For Each myShp In ActiveSheet.Shapes
myShp.Delete
Next myShp
を追加して、一旦表示されているオートシェイプを消してしまいます。

次に
＞If c.DisplayFormat.Interior.ColorIndex <> xlNone Then
あとはNo.2さんのコードそのまま
で条件付き書式で色がついているセルにオートシェイプが表示されると思います。

※　Excel2007までの場合はすでに回答されているように
IF　の条件に　条件付き書式の条件を細かく設定してやる必要があると思います。

どうも失礼しました。m(_ _)m

お礼

ご回答ありがとうございます。
使っているのが、2007なので、2010以降を使うときは、参考にさせていただきます。

回答No.2

watabe007

#1です。
>条件付き書式を使い、・・・・セルに色がつくように
If c.Interior.ColorIndex <> xlNone Then
↑これでは、条件付き書式で付けられた色は判別できないです。
ここに、条件付き書式の数式を記載してください。

お礼

ご回答ありがとうございました。

補足

ご回答ありがとうございます。

条件付き書式には、
=WEEKDAY($A6)=7や=WEEKDAY($A6)=1 などが入っているのですが、（Ａ６からＡ３６までに2013/12/28などの情報があります）この式を直接入れてしまってよろしいのでしょうか？

回答No.1

watabe007

こんばんは、参考に
Dim c As Range
'前回の直線を削除
ActiveSheet.Lines.Delete
For Each c In Range("B1:B31")
　　If c.Interior.ColorIndex <> xlNone Then
　　　　With ActiveSheet.Shapes.AddLine(c.Left, c.Top + c.Height / 2, c.Offset(, 13).Left, c.Top + c.Height / 2)
　　　　　　.Line.ForeColor.SchemeColor = 10
　　　　End With
　　End If
Next

お礼

ご回答ありがとうございました。