エクセルのマクロで数値に応じてオートシェイプの色を変更したいのですが・

Question

エクセルのマクロで数値に応じてオートシェイプの色を変更したいのですが・・・
マクロは初心者なもので、同じような例を調べて何度も試みたのですが、なかなか思い通りに動くプログラムが作れません。
どなたかマクロに詳しい方、ご教授願えればと思います。
やりたいことは以下の通りです。

シートが２つあります。
Sheet1には210の村について、人口性比のデータが列挙してあります。
Sheet2には、地図の中に、全ての村の所在をオートシェイプで作った○に番号をつけて表示してあります。

マクロを用いてやりたいことは、
Sheet1のG列にある人口性比の数値に応じて、以下の条件を元にSheet2のオートシェイプ（210個すべて）の色を変更させたいのです。
-950以上ならば黄色
-900以上950未満ならば緑
-850以上900未満ならば水色
-800以上850未満ならば青
-800未満ならば紺
というぐあいに。

他のデータに関しても同様に地図上で数値に応じた色分けをしたいので、一つ手本になるものができれば非常に有難いのですが。。

あと、macを使っているのですが、なかなか成功に至らないのはwindowsとのVBAの互換性の問題もあるのでしょうか？？

どなたかアドバイス宜しくお願いします。

lll49erlll · Accepted Answer

macのVBAとの差異については よく分からないのですが、基本的な物については共通だと思ってます。

オートシェイプの扱いには、シェイプの名前の管理がネックになります。
index番号で管理しても「Oval ｎ」のような名前の連番で管理しても　変な数値から始まったり
途中が抜けていたり、コピーなどした場合、変な番号に飛んでいたり、扱いづらいものです。

出来れば H列(あとで非表示にしてもいい)の それぞれの「村」に対応した行にシェイプ名を記入して
おくことを お勧めします。
　シェイプ名はシェイプをクリックしたとき名前ボックス(macでは名前が違うと思うが数式バーの
一番左の枠)に表示される名前です、それをコピーしてH列の対応する「村」の行に貼りつければ
いいと思います、数が多いですが、「村」とシェイプを対応付けるには、それが確実だと思います

それが 出来ていれば簡単な、行をたどるfor～nextかDo～Loop内で処理できます。
例えば、、↓

Sub オートシェイプ色別()

Dim SHP As String 'オートシェイプの名前
Dim COL As Integer '色番号
Dim I As Integer

I = 2 '２行目から始まるとして、、
    
    Do Until Sheets("Sheet1").Cells(I, 8).Value = ""
    
        Select Case Sheets("Sheet1").Cells(I, 7).Value
            Case Is >= 950: COL = 13
            Case Is >= 900: COL = 17
            Case Is >= 850: COL = 15
            Case Is >= 800: COL = 12
            Case Else: COL = 11
        End Select

SHP = Sheets("Sheet1").Cells(I, 8).Value  'H列のシェイプ名を取得
        With Sheets("Sheet2").Shapes(SHP).Fill
            .Solid
            .ForeColor.SchemeColor = COL
        End With
       I = I + 1　　'１行ごとに「村」の行があるとして、、、 
    Loop
    
End Sub

全く実証してませんが一連の流れはこんなもんでいいんじゃないでしょうか。

lll49erlll · Answer

lll49erlll です。

先程 win版 excel 2003で走らせたところ、異常なく実行できました。
　こちらでは、シェイプを選択して名前ボックスに出る「楕円 1」「楕円 2」・・・をコピーして
　セルにペーストしました。

シェイプ名の引数の異常ではないでしょうか？

エラーがでたときのデバッグでエラーが出る上の行の SHP にマウスカーソルを持っていったとき
SHPの値が 正しく表示されるでしょうか？

sub 選択()
ActhiveSheet.Shapes("ここにセルに入れたシェイプ名をペースト").Select
End Sub

↑ 上記のコードを、追加して 実行してたとき、該当のシェイプが選択できるでしょうか
シェイプのあるシートで試して下さい

lll49erlll · Answer

この場を借りて 一言申し上げます。
　いつもながらWendy02さんの ご回答の内容には感銘を受けている一人です。

コードを深く読み解くにつれ、技術に裏付けされた心遣いや提示する者の責任などが感じられ、
　私や、質問者に限らず、回答者でも考学の範としている人も多いことと思います。
　これからも我々 稚拙なものへの教示のためにも ここで ご活躍して頂けるよう、お願い致します。

今回はまだまだ 私の稚拙で直感的な考えが 質問者の方に共感を頂けただけだと思いますが、、
私もオートシェイプの扱いに苦労したことがあり、質問者が地図に落としこんである とのことから、
問題のオートシェイプ以外にも 凡例欄や、目印的に四角や三角など、またはエリアを示す大きな丸
など、はたまた矢印とか、、いろいろなオートシェイプを多用してあるのではないかと思い、
直感的に先の内容で提案させていただきました。

ただ、200を超えるオートシェイプ名を手動でコピ・ペさせるには、配慮の無さを感じております
ユーテュリティ的にシェイプを選択したらシェイプ名をセルに取得するようなものを提示すべき
だと思っておりました、
しかし 業務の間のコーヒータイムに直感を頼りに提案させていただいてる者として、精一杯でした
のでヒント的なものだけ載せさせて頂き、失礼いたしました。
　私もこの欄を自分のスキルアップのために大変参考にさせて頂いております、今後ともよろしく
お願いいたします。

質問者の方のエリアをかりて、失礼いたしました。

Wendy02 · Answer

私は、こちら側のカテゴリはあまり書いてはいませんが、ずっと思ってきたことを、少し筋違いかもしれませんが、書かせてください。

案の定の反応のようです。

>今回lll49erlllさんから教えていただいた方式のほうが私のような度初心者にとっては分かりやすかっため、そちらを採用させていただきました。

私の書く内容に対して、ここのカテゴリの4分の3ぐらいは同じ反応です。だから、最近、ある人には、親切心から、ここの掲示板に、同じような高度な内容の質問は、もう書くのは辞めて専門掲示板に書いたほうがよいと書いたぐらいです。別に、lll49erlllさんを批判しているわけではありません。

#3で書いたように、その人の良かれと思って、いろんな工夫を凝らしたマクロは、コードを書いた人の心遣いが出ているはずです。それが通じるのは、それが分かる人だけです。ただ、おそらく、見ただけで判断しているのだろうと思います。

ここのカテゴリで、日付のエラーを回避するコードを書いたら、私に対して、「自分自身に酔っている」と誹謗中傷した人がいました。読めない人には、その程度にしかありません。場合によって、10行で済むコードが、20行も30行もなることがあります。エラー回避というのは、たかがVBAプログラマでも、上達するためには最低限のルールです。

私が見た感じでは、#2のエラー回避は、少しややこしいように思います。私は、Index処理のほうが楽だと想定していますから、#3のオプションマクロを考えました。それで、どのオートシェイプがどれだと分かるように作られています。それはトグルになっていますから、もう一度実行すれば、元に戻ります。ただ、それは、lll49erlllさんのお考えにお任せすることにします。こちらからは何も言いません。

使う人が、自力でエラー回避出来ない限りは、エラー回避コードを付けてもらわなくてはなりませんが、その分難しくなります。別に皮肉で言っているわけではありませんが、私は、絶対に、初心者向けというようなコードで間に合わせるつもりはありません。それをしたら、こちらがオシマイになってしまいます。許される範囲で、全力で書くということをしなければ、ダメになります。ただし、有償レベルのものは、掲示板では公開しません。法的に、ほとんどのVBAのコードには、著作権を主張できないからです。

一般の人たちは、本格的に書かれたコードなどはまず見ることがありませんが、素人の人が読めるものではないのです。それを可読性という美名で、簡略化したり、コード自体を制限することもありません。

なお、質問さん側から、「採用」「不採用」という言い方は、遠慮してくださるようにお願いします。私は、その言葉が嫌いです。別に、私は、上から目線で、教えているという意識はありませんが、こちらのマクロを、たかが掲示板で、査定されダメ出しされるような立場で臨んでいるわけではないからです。

Wendy02 · Answer

#1の回答者です。

#1は、Sheet1 とSheet2の違いが抜けていました。それはミスですが、
初歩的な話ですが、Index とは、順序と同じ意味ですから、番号の抜けなどはありませんが、まあ、#2さんのご指摘の問題に対しては、私は、オプションマクロで対処しようと考えました。

こういう問題は、心遣いの問題で、技術的な問題ではありませんから、通じない人は、何を言っても始まりませんね。

Sub TestMacro1R()
Dim i As Long
Dim iClr As Integer
Dim fig As Integer
Dim rng As Range
Dim sh As Worksheet
Set sh = Worksheets("Sheet2")
With ActiveSheet
Set rng = .Range("G1", .Range("G1000").End(xlUp)) 'オートシェイプは、1000個まで
For i = 1 To sh.Shapes.Count
　 If sh.Shapes(i).Type = msoAutoShape Then
　　　 sh.Shapes(i).Fill.ForeColor.SchemeColor = Fig2Clr(rng.Cells(i))
　 End If
Next
End With
Set rng  Nothing
End Sub
Function Fig2Clr(ByVal n As Integer)
Dim iClr As Integer
Select Case n
　Case Is >= 950: iClr = 13
　Case Is >= 900: iClr = 17
　Case Is >= 850: iClr = 15
　Case Is >= 800: iClr = 12
　Case Else: iClr = 11
End Select
　Fig2Clr = iClr
End Function

'//

Sub ShapesIndexChecker()
　'オプション　Index の確認 シェイプのあるシートで実行
　Dim i As Long
　Dim shp As Shape
　For Each shp In ActiveSheet.Shapes
　　With shp
　　　If .Fill.Visible = msoTrue Then
　　　　.Fill.Visible = msoFalse '塗りつぶしなし
　　　　.DrawingObject.Font.Size = 12 'フォントサイズ
　　　　.DrawingObject.Text = shp.DrawingObject.Index
　　　Else
　　　　.Fill.Visible = msoTrue
　　　　.DrawingObject.Text = ""
　　　End If
　　End With
　Next
End Sub

Wendy02 · Answer

>macを使っているのですが、なかなか成功に至らないのはwindowsとのVBAの互換性の問題もあるのでしょうか？？

それは、分からないです。エラーが出ているというならともかく、単なる文章だけでは、無責任に良いとも悪いも言えますが、具体性がないものに確実なことは何もありません。

>オートシェイプ（210個すべて）の色を変更させたいのです。
これは、Index での管理ですから、もしも、名称の管理でしたら、Shapes(i) の部分を

例えば、丸でしたら、このようになります。ただ、["Oval " & i ]で、Oval の後、スペースが空いています。名称は、バージョンによって変わります。

If .Shapes("Oval " & i).Type = msoAutoShape Then
　　.Shapes("Oval " & i).Fill.ForeColor.SchemeColor = Fig2Clr(rng.Cells(i))
End If

'//
Sub TestMacro1()
Dim i As Long
Dim iClr As Integer
Dim fig As Integer
Dim rng As Range
With ActiveSheet
Set rng = .Range("G1", .Range("G1000").End(xlUp)) 'オートシェイプは、1000個まで
For i = 1 To .Shapes.Count
　 If .Shapes(i).Type = msoAutoShape Then
　　.Shapes(i).Fill.ForeColor.SchemeColor = Fig2Clr(rng.Cells(i))
　 End If
Next
End With
End Sub
Function Fig2Clr(ByVal n As Integer)
Dim iClr As Integer
Select Case n
　Case Is >= 950: iClr = 13
　Case Is >= 900: iClr = 17
　Case Is >= 850: iClr = 15
　Case Is >= 800: iClr = 12
　Case Else: iClr = 11
End Select
　Fig2Clr = iClr
End Function

エクセルのマクロで数値に応じてオートシェイプの色を変更したいのですが・

macのVBAとの差異については よく分からないのですが、基本的な物については共通だと思ってます。

この回答への補足

lll49erlll です。

この場を借りて 一言申し上げます。

私は、こちら側のカテゴリはあまり書いてはいませんが、ずっと思ってきたことを、少し筋違いかもしれませんが、書かせてください。

#1の回答者です。

>macを使っているのですが、なかなか成功に至らないのはwindowsとのVBAの互換性の問題もあるのでしょうか？？

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

macのVBAとの差異についてはよく分からないのですが、基本的な物については共通だと思ってます。

この場を借りて一言申し上げます。