「VBA」オートシェイプを条件で判断し、色づけ

質問

お世話になります。
VBA初心者です。かなり困っておりましてWeb上を調べ回りましたがどうしてもわからずご教授いただきたく、お願い致します。

仕様

時間をセルから取得し、その時間を条件で判断しFor文で回しオートシェイプを赤、青、黄の信号で表すというプログラムです。
値が入ってる行は25行で、それぞれ対応するセル(時間が入っている)から値を取得し、条件で判断し、オートシェイプ(デフォルトは白塗りで隠してある)に色付け。

項目がそれぞれ
・時間1
・時間2
・条件1
・条件2
があり

時間1は条件1で判断、オートシェイプ1～２５を色づけ
時間2は条件2で判断、オートシェイプ1～２５を色づけ
。

条件1:

・0から50分未満…青
・50分から60分未満…黄
・60分以上…赤

条件2:
・0から150分未満…青
・150分以上180分未満…黄
・180分以上…赤

わかりづらい説明で大変申し訳ありません。
丸投げ状態で恐縮ですがよろしくお願い致します。。

回答No.1

rukuku · ベストアンサー

はじめまして

オートシェープの色を変えるサンプルプログラムです。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2009/2/3 ユーザー名 : rukuku
'

'
ActiveSheet.Shapes("Oval 1").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
End Sub

「マクロの記録」を使っただけなので、ちょっと効率の悪い書き方ですが、ちゃんと動きます。
最初はこのまま、もう少し分かってきたら改良して使ってください。
「マクロの記録」は、いいサンプルプログラムになるので、重宝しています。

＞時間1は条件1で判断、オートシェイプ1～２５を色づけ
＞時間2は条件2で判断、オートシェイプ1～２５を色づけ

こちらは
「If then」で書いてもいいのですが、「Select Case」の方が記述が簡単です。

Select Case 時間1
Case Is >= 60
signal(1) = 10
Case Is >= 50
signal(1) = 13
Case Is < 50
signal(1) = 12
End Select
と変数「signal(1)」に色を代入しておいてから、

Selection.ShapeRange.Fill.ForeColor.SchemeColor = signal(1)
と、色の変更を実施します。

回答No.3

n-jun

＃２です。

＞値が入ってる行は25行で
＞オートシェイプ1～２５を色づけ
と言う事は、オートシェイプ２５個は２５行のデータそれぞれで個別に色をつけると
言う事になるのでしょうから、＃２の場合データの行数とオートシェイプ２５個の
名前（No）順が合わないと使えないかもです。

２行目のデータ　　オートシェイプ　１
３行目のデータ　　オートシェイプ　３
４行目のデータ　　オートシェイプ　４
とかの場合です。

その時はスル～して下さい。

回答No.2

n-jun

参考までですが。

Sub try()
Dim sh As Excel.Shape

For Each sh In ActiveSheet.Shapes
Debug.Print sh.Name, "オートシェイプNo." & Split(sh.Name, " ")(1)
Next

End Sub

オートシェイプの番号で必要なセル番地から値を取得し、色の条件判断をして
色の変更をしてみては如何でしょう。