[[20040526141145]]　『図形の色を数値により変化させたい』（とも）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『図形の色を数値により変化させたい』（とも） 

 オートシェイプで作った図形の色を、
 あるセルに入った数値を見て変化させたいのですが
 出来ますか？？


 例えば・・・
 図形１はＡ１の数値をみる。
 図形２はＡ２の数値をみる。
 それぞれの図形を数値が50以上なら赤、100以上なら青、150以上なら黒
 とかにしたいのですが。。。


 私の知識では無理なので、誰か分かる方がいらっしゃったら
 教えて下さいm(>_<)m


 マクロを使えば可能ですので、ひとまず作ってみました。


 Private Sub Worksheet_Change(ByVal Target As Range)


    Select Case Target.Address(0, 0)
    Case "A1"
        ActiveSheet.Shapes("図形１").Select
    Case "A2"
        ActiveSheet.Shapes("図形２").Select
    Case Else
        Exit Sub
    End Select


    Select Case Target.Value
    Case Is >= 150
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
    Case Is >= 100
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
    Case Is >= 50
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    End Select


    Target.Select
 End Sub 


   (INA)


 確認が遅くなりました(>_<)
 できました！！ありがとうございますξξ *´▽｀)ノ


 あと質問があるのですが、"図形１"の部分はどこをみれば分かりますか？？
 とりあえず"Freeform 2"に変えてやったら出来たのですが、
 その図形が Freeform の何番かって言うのはどこで確認できますでしょうか？？
 教えて下さいm(._.)m


 （とも）


 (INA)さんのマクロを参考に以下のように作ってみました！


 Private Sub Worksheet_Change(ByVal Target As Range)


    Select Case Target.Address(0, 0)
    Case "C2"
        ActiveSheet.Shapes("Freeform 3").Select
    Case "C3"
        ActiveSheet.Shapes("Freeform 4").Select
    Case "C4"
        ActiveSheet.Shapes("Freeform 5").Select
    Case "C5"
        ActiveSheet.Shapes("Freeform 6").Select
    Case "C6"
        ActiveSheet.Shapes("Freeform 7").Select
    Case "C7"
        ActiveSheet.Shapes("Freeform 8").Select
    Case "C8"
        ActiveSheet.Shapes("Freeform 9").Select
    Case "C9"
        ActiveSheet.Shapes("Freeform 10").Select
    Case "C10"
        ActiveSheet.Shapes("Freeform 11").Select
    Case "C11"
        ActiveSheet.Shapes("Freeform 12").Select
    Case "C12"
        ActiveSheet.Shapes("Freeform 13").Select
    Case "C13"
        ActiveSheet.Shapes("Freeform 14").Select
    Case "C14"
        ActiveSheet.Shapes("Freeform 15").Select
    Case Else
        Exit Sub
    End Select


    Select Case Target.Value
    Case Is >= 0.05
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.1
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.15
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.2
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.25
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 53
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.3
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 14
        Selection.ShapeRange.Fill.Transparency = 0.65
    End Select


    Target.Select
 End Sub


 しかし、これだとどんな数字を入れても（0.05以下を除く）
 0.05以上の時の設定色（黄色）にしか変わってくれないのですが
 どうしたらよいのでしょうか？？
 ホント初心者で申し訳ないです(>_<)


 （とも）


 聞く順序を逆にしてください。


   Select Case Target.Value
    Case Is >= 0.3
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 14
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.25
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 53
        Selection.ShapeRange.Fill.Transparency = 0.65
    Case Is >= 0.2
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
        Selection.ShapeRange.Fill.Transparency = 0.65
    End Select
    ....
    Case Is >= 0.05
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
        Selection.ShapeRange.Fill.Transparency = 0.65
    End Select


 （kazu）


 (ﾟ〇ﾟ;)・・・なるほど・・・
 まぬけ感たっぷりな質問でしたね。普通に考えたら分かりそうなものを(p_-)
 すいませんでした！kazuさんありがとうございます！
 （とも）


 あ・・と、数値が入るセルは計算させてるんですね。
 =A1/B1
 という式が入ってて、その計算結果で図形の色を変えたいのです。
 A1とB1に数値を入れるとC1に結果が出ますが、
 図形の色は変わってくれないのですが、、、どうしたらよいでしょうか？
 一度セルをダブルクリックしてエンターすると変わってくれるのですが・・・
 マクロ難しいです(>_<)
 （とも）

 >その計算結果で図形の色を変えたいのです。
 Worksheet_Calculate　イベントにしては如何でしょうか？


  (INA)


 「計算が終わったとき」ってことですよね？
 変えてみたのですが、A1に数字を入れた時点で
 「オブジェクトが必要です」
 というエラーが出てくるのですが、どうしたらよいのでしょうか(´；-；｀) ？？
 （とも）

 changイベントで数式の元になっているセルをTargetにしては如何でしょうか？


  (INA)


 ・・・すいません・・・
 もうちょっと噛み砕いてお願いします(>_<)


 Select Case Target.Address(0, 0)
 の部分を変えたら良いってことでしょうか？？
 しかしどう変えていいのか・・・
 （とも）

 >A1とB1に数値を入れるとC1に結果が出ますが、


 であれば、
 セル値が変化したときに対象にするセルは、A1, B1
 として、値は C1 を基準にすればよいです。　　　 


 Private Sub Worksheet_Change(ByVal Target As Range)
    '対象セル以外はマクロ終了 
    If Target.Column > 2 Or Target.Row <> 1 Then Exit Sub


    Select Case Target.Address(0, 0)
    Case "A1"
        ActiveSheet.Shapes("図形１").Select
    Case "A2"
        ActiveSheet.Shapes("図形２").Select
    Case Else
        Exit Sub
    End Select


    Select Case Range("C1").Value
    Case Is >= 150
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
    Case Is >= 100
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
    Case Is >= 50
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    End Select


    Target.Select
 End Sub 


 　　(INA)


 考え方は分かりました！
 実際には D2/C2=E2 としているのですが、、、


 Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Column > 2 Or Target.Row <> 1 Then Exit Sub


    Select Case Target.Address(0, 0)
    Case "D1"
        ActiveSheet.Shapes("図形１").Select
    Case "D2"
        ActiveSheet.Shapes("図形２").Select
    Case Else
        Exit Sub
    End Select


    Select Case Range("E1").Value
    Case Is >= 150
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
    Case Is >= 100
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
    Case Is >= 50
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    End Select


    Target.Select
 End Sub 


 これでいいのでしょうか？！
 こう変えてみたのですが、全く色が変わってくれないのですが・・・
 もっと勉強しなきゃ駄目ですね、すいませんm(_ _)m
 （とも）

 > If Target.Column > 2 Or Target.Row <> 1 Then Exit Sub


 これは変化したセルの 列が２以上
 または 行が １ 以外のときは
 マクロを終了という意味です。


  If Target.Column < 3 Or Target.Column > 4 Or Target.Row <> 2 Then Exit Sub


  (INA)


 ・・・なんかどつぼハマってます・・・


  If Target.Column < 3 Or Target.Column > 4 Or Target.Row <> 2 Then Exit Sub
 に変更するとE2を見ている図形は色変化してくれるのですが、
 それ以外のセルを参照している図形は変化しません。


 色変化させたい図形は全部で40個です。
 図形が値を見に行くところはE2〜E41なんですね。
 なので


  If Target.Column < 3 Or Target.Column > 4 Or Target.Row > 2 Or Target.Row < 41 Then Exit Sub


 になるのでしょうか？変えてみました
 また色が変わらなくなったんですが・・・(/_･､)
 自分の知識のなさに泣けてきます。すいません。
 （とも）

 これまた、あまりよく見ていませんが、
 ↓が参考になりませんか？
 (夏目雅子似）
 Private Sub Worksheet_Change(ByVal Target As Range)


 If Intersect(Target, Range("A1:A2, C1:C2")) Is Nothing Then Exit Sub


 MsgBox "川に立ち　鮎の香りに　夏本番", vbInformation, _
 "入選おめでとうございます。"


 End Sub

 ガ━━Σ(ﾟдﾟlll)━━ン!!!
 駄作発見！！(^_^A;
 （川野鮎太郎）

 >図形が値を見に行くところはE2〜E41なんですね。
 それらのセルには数式が入っているのですか？


  (INA)　

 さっき↓こんな感じでやってみたら出来ましたけど、、


 少し気になったのが、


 ＞実際には D2/C2=E2 としているのですが、、、


 なのに、


 >Select Case Range("E1").Value
　　　　　　　　　　　↑


 あと、
 ＞図形１はちゃんと選択されていますか？


 一度マクロの記録で選択してみて確認してみるといいかも知れませんね。


 余計なお世話かもしれませんが、ご参考までに。。。
 （夏目雅子似）


 Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Count > 1 Then Exit Sub


    If Intersect(Target, Range("D1:D2")) Is Nothing Then Exit Sub


    Application.EnableEvents = False


    Select Case Target.Address(0, 0)
        Case "D1"
            Me.Shapes("AutoShape 1").Select
        Case "D2"
            Me.Shapes("AutoShape 2").Select
        Case Else
            Application.EnableEvents = True
            Exit Sub
    End Select


    Select Case Range("E2").Value
        Case Is >= 150
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
        Case Is >= 100
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
        Case Is >= 50
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    End Select


    Target.Offset(1).Select


    Application.EnableEvents = True


 End Sub


 またまた確認が遅くなりすいませんm(_ _)m


 >>図形が値を見に行くところはE2〜E41なんですね。
 >それらのセルには数式が入っているのですか？
 入っています。


 　 　A　　B　　C　　　D　　 　 　E
  2　　　　　　100　 15000　 =C2/D2(150)　　図形１
  3            100    5000   =C3/D3( 50)　　図形２
　　　・
　　　・
　　　・
 41　　　　　　100　 10000　 =C41/D41(100)　図形４１


 と↑このようになっているのです。
 （夏目雅子似）さんのを参考に下記のようにしてみましたが
 色が変わらなくなってしまいました(T_T)（とも）


 Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Count > 1 Then Exit Sub


    If Intersect(Target, Range("D2:D3")) Is Nothing Then Exit Sub


    Application.EnableEvents = False


    Select Case Target.Address(0, 0)
        Case "D2"
            ActiveSheet.Shapes("Freeform 1").Select
        Case "D3"
            ActiveSheet.Shapes("Freeform 2").Select
        Case Else
            Application.EnableEvents = True
            Exit Sub
    End Select


    Select Case Range("E2").Value
        Case Is >= 150
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
        Case Is >= 100
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
        Case Is >= 50
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    End Select


    Target.Offset(1).Select


    Application.EnableEvents = True


 End Sub


 数式が入っているなら Value プロパティでなく、 
 Text プロパティにしては如何ですか？


  (INA)

 衝突しましたぁ、、、
 ありゃま、もう、完全に忘れていました。ごめんなさいm(__)m
 少し、気になったのが
 =C2/D2
 では、150にならないと思うのですが、
 どうでしょう？
 一応↓の様にしてみました。
 D2,D3,D41に数値をいれて、E列の値を変化させて下さい。
 エラーが途中で発生してイベントが無効になっていませんか？
 その様な場合は、一度違うシートを選択してから
 当該シートを選択しなおしてから実行してみてください。
 後は、適当に応用してください。
 で、どうでしょう？
 (夏目雅子似）


 Private Sub Worksheet_Activate()
 Application.EnableEvents = True
 End Sub


 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyRow As Integer
    If Target.Count > 1 Then Exit Sub
    'E2,E3,E41の値をD2,D3,D41で変えると仮定しています。
    '従って、セルがD2,D3,D41の何れかにいないとイベントは発生しません。
    If Intersect(Target, Range("D2:D3", "D41")) Is Nothing Then Exit Sub
    'イベントを無効にします。
    Application.EnableEvents = False
    'ターゲトのアドレスによって選択する図形と参照するE列の行を決定します。
    Select Case Target.Address(0, 0)
        'ターゲットがD2の場合はオートシェイプの1を選択して
        '行に2を代入します。
        Case "D2"
            ActiveSheet.Shapes("Rectangle 1").Select 'Rectangle 1は実際の図形を選択して
            MyRow = 2                               'それを記録して確認してください。
        'ターゲットがD3の場合はオートシェイプの2を選択して
        '行に3を代入します。
        Case "D3"
            ActiveSheet.Shapes("Rectangle 2").Select 'Rectangle 2は実際の図形を選択して
            MyRow = 3                               'それを記録して確認してください。
        'ターゲットがD41の場合はオートシェイプの3を選択して
        '行に41を代入します。
         Case "D41"
            ActiveSheet.Shapes("Rectangle 3").Select 'Rectangle 3は実際の図形を選択して
            MyRow = 41                              'それを記録して確認してください。
        Case Else
            Application.EnableEvents = True         '必要ないと思いますが一応入れておきます。
            Exit Sub
    End Select
    'ターゲットのアドレスで選択する図形を決定して（図形はSelectionで表しています。）
    'それに対応する行を変数MyRowで決定します。
    Select Case Range("E" & MyRow).Value
        Case Is >= 150
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
        Case Is >= 100
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
        Case Is >= 50
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 7
    End Select
    'ターゲットの一つ下のセルを選択します｡
    Target.Offset(1).Select
    'イベントを有効にします。
    Application.EnableEvents = True
 End Sub


 丁寧に説明していただいてありがとうございます！！
 上記マクロを自分のエクセルに当てはめてみたところ、ちゃんと動きました！！
 どうもありがとうございますm(_ _)m！！
 みなさんありがとうございました！ もっと勉強して理解を深めたいと思います(>_<)
 （とも）


 お節介かもしれませんが、
 Valueプロパティ と Textプロパティ の違いは理解しておいて下さいね。 


  (INA)
コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.