エクセルで地図を作成し、オートシェイプの色を自動更新したい。

質問

エクセルに2つのシートがあります。シート１には15営業所の年度別販売個数があります。シート２には、自分で作成した地図があり、15営業所の位置をオートシェイプで作成した●（丸）で地図内に表示しています。

　次にシート1において対前年度比率を営業所別に求めました。（例　Ｓ営業所　対前年度106％の販売増）
　この対前年度比率に応じて、シート２のオートシェイプの色は、変えられるのでしょうか？　

　具体的には、対前年度100％～105％はオレンジ、106％～110％は赤・・・というようにしたいのです。

　数値に応じてセルの色を変える方法は分かるのですが、指定したオートシェイプの色は変えられるのでしょうか？
　関数、ＶＢＡでの解決方法を是非教えてください。よろしくお願いします。

回答No.1

imogasi

余り同類の質問も載らず、経験もないので、よくわかってないところがありますが、マクロの記録とか、ＷＥＢの情報でやってみました。

(1)スキームカラーを知る
　　　（Ａ）四角形を作る（Ｓｈｅｅｔ４に）
Sub test05()
For i = 1 To 60
Sheets("Sheet4").Shapes.AddShape(msoShapeRectangle, 35, 30 + 30 * i, 40, 20).Select
Next i
End Sub
（Ｂ）見本として、四角形にスキームカラーをつける（Ｓｈｅｅｔ４の四角形に）
Sub Test4()
Dim obj As Object
Dim i As Long
Worksheets("sheet4").DrawingObjects.Select
i = 0
For Each obj In Selection
i = i + 1
' MsgBox i & " " & obj.Name
obj.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = i
Selection.Characters.Text = i
Next

End Sub
以上でどんな色をつけるか考えて、決めておく。

（２）シートＳｈｅｅｔ２のＢ列のセルの値によって、Ｓｈｅｅｔ１のオートシェイプの色を設定する。
質問とＳｈｅｅｔ１、Ｓｈｅｅｔ２が逆で、すみません。オートシェイプは、四角を使ってます。個数は１０個にしてます。これらの質問者のケースに合わせた変更はお分かりでしょう。
Ｓｈｅｅｔ２のＡ列には実データ（販売個数）をいれ、Ｂ列には前年比販売増率）がはいっているとします。
実行するときはＳｈｅｅｔ１をアクチブにして実行のこと。そうしないとエラーになる。
Sub test01()
For i = 1 To 10
Sheets("Sheet1").Shapes("Rectangle " & i).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
'------
Select Case Sheets("Sheet2").Cells(i, "B")
Case 100 To 105
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 3
Case 106 To 110
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Case 111 To 115
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 6
Case 116 To 120
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 7
Case Is > 120
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 26
Case Else
End Select
'-------
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.Characters.Text = i & "/" & Sheets("sheet2").Cells(i, "A") & _
"/" & Sheets("sheet2").Cells(i, "B")
Next i
End Sub
Selection.ShapeRange.Fill.ForeColor.SchemeColorをマクロの記録につられて、使いましたが、オートシェイプの
色付けに他の方法があれば（Ｃｏｌｏｒ，Ｃｏｌｏｒｉｎｄｅｘ等）そちらを使ってください。