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

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

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

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

No.5 ベストアンサー 回答者： watabe007 回答日時： 2013/12/29 08:29

>祝日は、違うシートに書き出して、条件に=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

この回答へのお礼

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

お礼日時：2013/12/29 15:12

No.4 回答者： watabe007 回答日時： 2013/12/28 22:36

>条件付き書式には、

>=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（Ｂ２：Ｂ７２まで祝日等のデータあり）を入れています。

補足日時：2013/12/28 23:20

No.3 回答者： tom04 回答日時： 2013/12/28 22:31

こんばんは！

横からお邪魔します。
オートシェイプを挿入するマクロは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以降を使うときは、参考にさせていただきます。

お礼日時：2013/12/29 01:37

No.2 回答者： watabe007 回答日時： 2013/12/28 19:20

#1です。

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

この回答への補足

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

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

補足日時：2013/12/28 21:10

No.1 回答者： watabe007 回答日時： 2013/12/28 19:11

こんばんは、参考に

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