超初心者オートシェイプを数値によって色分けしたい

質問

M列に1から5の5段階評価の数値が入っているのですが
それを図に色分けしたいのでマクロでのわかりやすく
簡単な方法を教えてください。

1赤
2ピンク
3黄
4緑
5青

同様の質問が既にありますが土曜日、日曜日と調べながら
挑みましたが、解決できませんでした。

こちらはマクロ超初心者ですのでご理解いただけたらと思います

回答No.3

keithin · ベストアンサー

Ｍ列のどこに数字が入っているのかも、それぞれの数字に「対応するのはどこにあるどの図形なのか」も、何の情報もありません。

イチイチ説明を書いてもらうのもお互いにメンドクサイので、次の通りに作成することにします。

１．Ｍ２以下に不定個数、１から５までの数字が記入されている
２．各数字の「右隣のセル」（Ｎ２以下の各セル）に重なるように、四角形を描画して指定色を塗る事にする（これに伴い、シート上の余計な図形はとりあえず全部削除してから作業を開始することにする）

sub macro1()
　dim h as range
　dim a as variant
　a = array("",vbred, vbmagenta, vbyellow, vbgreen, vbblue)
　activesheet.rectangles.delete

　for each h in range("M2:M" & range("M65536").end(xlup).row)
　　if 1 <= h and h <= 5 then
　　　with h.offset(, 1)
　　　with activesheet.shapes.addshape(msoshaperectangle, .left, .top, .width, .height)
　　　　.fill.forecolor.rgb = a(h.value)
　　　　.name = "Rect" & h.address(false, false)
　　　end with
　　　end with
　　end if
　next
end sub

あなたのヤリタかった事と食い違ってる部分は、まぁとりあえずまずは自力で適切に応用して作成してみて下さい。

お礼

とても親切に回答をいただきクリスマスプレゼントをいただきました。
私のつたない説明でここまで作成していただき本当に感謝してます。
初めての質問でしたので大変へたくそだったことをお許しください。
感謝してます

回答No.2

karasu1201

重ねて回答します。

とりあえずピンクだけ書いてみました。

Sub ShapeSample()
'追加したオートシェイプの書式を設定する
'Cell１の数値が10ならばテキストボックスの色を変えて出力します。
If Sheet1.Cells.Text = 10 Then
Set oShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 64, 64)
With oShape
.Fill.ForeColor.RGB = RGB(255, 128, 192) '塗りつぶし色
.Fill.Visible = msoTrue
.Fill.Solid 'グラデーション等
.Line.ForeColor.RGB = RGB(192, 255, 128) '線の色
.Line.Visible = msoTrue
End With
End If
End Sub

単純にCell A1の値が数値で10なら出力します。
またご自分で弄っていただいて、詰まったらご質問お願いいたします。

お礼

ご丁寧に対応していただき本当に感謝してます。
貴重なお時間とクリスマスということで
記憶に残る御回答でした。
今から試すので時間がとてもかかるとおもいますが。。
メリークリスマス

回答No.1

karasu1201

こちらにソースを書くとえらいことになるので書きURLを参考にしてください。

参考URL：

http://blog.livedoor.jp/qoozy/archives/52551291.html

補足

早速ご回答いただきありがとうございます。
当方の説明不足によりお手数おかけしたことをお詫び申し上げます。

それぞれのオートシェイプを数値によって色分けしたいのですが、
5個の数値にそれぞれ色分けして表示させたいです

1 赤
2 ピンク
3 黄
4 緑
5 青

当方による教えていただいたサイトの見落としでした場合
再度お詫び申し上げます。
ご回答には感謝します。