エクセル マクロで教えて下さい。

質問

入力されたセルの値で、フリーフォーム（図形）の色を変えるマクロを作成しました。
（色々の方のお力をお借りしておりますが。。。）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mShp As String, SCol As Integer

Select Case Target(1).Address(0, 0)
Case "A1": myShp = "フリーフォーム 1"
Case "A8": myShp = "フリーフォーム 8"
Case "B3": myShp = "フリーフォーム 3"
Case Else: Exit Sub
End Select

Select Case Target(1).Value
Case 1: SCol = 10
Case 2: SCol = 13
Case 3: SCol = 12
Case 4: SCol = 11
Case 5: SCol = 15
Case Else: SCol = -1
End Select

With Me.Shapes(myShp).Fill
If SCol = -1 Then
.Visible = msoFalse
Else
.Visible = msoTrue
.ForeColor.SchemeColor = SCol
End If
End With

End Sub

A1,A8,B3に直接値を入力すると色が変化しますので、問題ないのですが、VLOOKUP等で別シートの値を、A1,A8、B3に表示させても色が変わらない事がわかりました。

そこで、このマクロでVLOOKUP等で引っ張って来た場合でも対応出来る様に変更する事は可能でしょうか？
それが出来ない場合は、別シートのセルを直接参照し色を変化出来る様に変更する事が出来ないでしょうか？

これを作成するのに聞いた人間はマクロに詳しい方々ですが、当方は、マクロは素人同然です。
詳しく説明していただければ幸いです。
何卒よろしくお願い致します。

回答No.3

cj_mover · ベストアンサー

こんにちは。
＃１補足欄へのレスです。

> ご回答の案をテストしてみましたが、実行されませんでした。

"実行されませんでした"だけでは、なんとも答えにくいですが、
一応関数なので、どんな値がセルに返されたとか書いて貰いたかったです。
それがないということは、たぶん、実装手順の問題なのかと思います。
以下、手順を確認してみてください。

■０■
　【色指定対象となるフリーフォームが設置されたシート】で
　A1、A3、B8に、数式または定数が設定され正常な値が表示されていることを、確認
■１■
　【対象ブック】の【標準モジュール】に ff色指定()関数 を過不足なく貼り付ける
■２■
　【色指定対象となるフリーフォームが設置されたシート】で
　どこか空いているセル３カ所に以下の【３つの数式をそれぞれ設定】する
　　=ff色指定(A1)
　　=ff色指定(A3)
　　=ff色指定(B8)

手順は以上です。
念の為。
【標準モジュール】... Module1 等の名前が付いたモジュールのことです。
　メニューバー[挿入][標準モジュール]　の手順で追加可能です。
他、【】の部分は間違えそうな所として強調しています。

ff色指定()関数は、戻り値として
　　参照先の値がエラー値なら　→　エラー値 #VALUE!
　　引数に指定したした参照先がA1、A3、B8のどれでもない場合は　→　数値 0
　　関数での処理が実行されていれば　→　文字列値 "色指定関数"
がそれぞれ ff色指定()関数 を設定したセルに表示します。

他に、エラーを返す原因として考えられるのは以下、
　・ff色指定()関数を設定したシートに色指定対象となるフリーフォームがない場合
　・指定したフリーフォームの名前が適切でない場合
　・色指定対象となるフリーフォームが設置されたシートが保護されている場合で
　　＋　フリーフォームがロックされている場合
などが考えられます。
どれも今回のオーダーからは大きく外れる条件なので、関係なさそうですけれど、、、。

上に挙げた手順が前後したり、参照先でミスったりした後で
ff色指定()関数の戻り値が #VALUE! となり、
その後、適正な条件に整え直したのに #VALUE! のまま変化しない場合は、
ff色指定()関数を設定したセルを選択→[F2 キー]→[Enter キー]
の手順でエラーをキャンセルします。

もし、手順を見直しても解決できない場合は、
メンテナンスにも不安が残るでしょうから、他の方法にした方がよいかも知れませんね。
今与えられている情報だけでは、これぐらいで限界です。

とりあえず、諸々確認してみてもらえますか？

回答No.2

misatoanna

私の環境は Win7、Excel2010 ですが、VLOOKUPで別シートの値を表示させても色は変わります。
もしかしたら、
・リボンのバージョンでしたら、開発タブの「デザインモード」
・以前のバージョンでしたら、コントロールツールボックスの「デザインモード」
がオンになっていませんか。

補足

ご回答ありがとうございます。
私の環境はWinXP、2010です。ご指摘のデザインモードを確認しましたが、OFFになっておりました。
他に何か原因があるのでしょうか？もし考えられる原因があれば教えていただければ幸いです。

回答No.1

cj_mover

こんにちは。

> ...別シートのセルを直接参照し色を変化出来る様に変更する事...
Worksheet_Change イベント は、
計算結果の戻り値の変動をきっかけにすることはできませんので、
数式の適用された範囲ではなく、
数式の適用された範囲の参照先を直接参照するという考え方は正しいです。

> ...VLOOKUP等で引っ張って来た場合でも...
その関数の中身や条件を詳らかに提示して貰えたら、
こちらで対応したものを書くことも可能です。
しかし、自ずと構造的に複雑化しますし、
設計が変わる度に対応するのは難しいものと思います。

そこで、もっと簡単に対応できる方法はないか、と考えました。
ユーザー定義関数を使った方法を紹介します。

ユーザー定義関数とは、
Excelのワークシートで用いる関数と同様の扱い方で、
ＶＢＡにより独自に定義した関数をワークシート上で設定するものです。

下に掲げる関数（ff色指定）を今回の課題に合わせた使い方としては、
　どこか空いているセル（３カ所）（どこでもいい）に
　　=ff色指定(A1)
　　=ff色指定(A3)
　　=ff色指定(B8)
と３つの数式を設定するだけです。
これで参照先のA1、A3、B8が数式でも定数でも、
変化した時だけ、必要な時だけ、必要十分に、
お望みの処理をしてくれるようになります。

通常、ユーザー定義関数は何かしら値を返す目的で使用するものですが、
この関数（ff色指定）は主に参照先の変化に
対応して処理することを目的としている為、戻り値はあまり意味を持ちません。
なので、シート上に数式を設定したセルを非表示にしても構いません。
ただ、誤って数式を消してしまったりしないように
一応の戻り値を表示するようにするとか、セルにコメントを追加しておくとか、
工夫しておいた方が良いかも知れません。

関数コードの内容自体はご提示のコードの原型を踏襲していますから、
手直しも容易です。

注意点は、
必ず標準モジュールに貼ること。
Worksheet_Change イベント との併用はしないこと。
の２点。

参考として
Worksheet_Change イベント の他に、
Worksheet_Calculate イベント を
イベント専用に追加した別シートに適用する方法などもあります。

が、
運用、メンテナンスの簡潔さ、や、無駄な処理が少ない点、
ＶＢＡに不慣れな方にも扱いやすい点、などなど
考えれば考えるほど、今回の課題にはユーザー定義関数が
適しているように思えてきます。
欠点としては、ユーザー定義関数のこうした使い方の認知度は低く、
食わず嫌い的に避ける人が多いことなどが挙げられますが、
やってることは本当に簡単なのですけどね。

尚、Excel2010で動作確認しています。

ともかく実際に試してみてください。
その上で疑問があれば、なんなりと、、、。

' ' 標準モジュール

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 解説：http://okwave.jp/qa/q8093155.html

Function ff色指定(範囲 As Range) ' 8093155
　　Dim myShp As String
　　Dim SCol As Integer

　　Select Case 範囲(1).Address(0, 0)
　　Case "A1": myShp = "フリーフォーム 1"
　　Case "A8": myShp = "フリーフォーム 8"
　　Case "B3": myShp = "フリーフォーム 3"
'　　Case Else: Exit Function '　　(１/２択)＿(１行)
　　Case Else '　　　　　　　　　　(２/２択)＿(３行)
　　　　MsgBox "指定できる範囲は、A1、A3、B8、の何れかです"
　　　　Exit Function '　　　規定外範囲指定の場合、リターンは、0 です
　　End Select

　　Select Case 範囲(1).Value
　　Case 1: SCol = 10
　　Case 2: SCol = 13
　　Case 3: SCol = 12
　　Case 4: SCol = 11
　　Case 5: SCol = 15
　　Case Else: SCol = -1
　　End Select

'　　With Sheets("Sheet1").Shapes(myShp).Fill ' (１/２択)＿(シート名を指定)
　　With 範囲.Parent.Shapes(myShp).Fill ' (１/２択)＿(範囲の親シートで指定)
　　　　If SCol = -1 Then
　　　　　　.Visible = msoFalse
　　　　Else
　　　　　　.Visible = msoTrue
　　　　　　.ForeColor.SchemeColor = SCol
　　　　End If
　　End With

　　ff色指定 = "色指定関数" '　　　リターンは自由に設定）

End Function

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

補足

ご回答ありがとうございます。
ご回答の案をテストしてみましたが、実行されませんでした。
私の環境はWinXPで2010です。
何か問題の解決の原因がありましたら、お知恵を貸していただければ幸いです。
よろしくお願い致します。