• ベストアンサー

エクセルの指定セルにある時だけ、指定オブジェクトの色が変化する方法を教えて下さい。

エクセルの指定セルにある時だけ、同じシート上の指定オブジェクトの色が変化する方法を教えて下さい。

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.4

補足、お礼等を読み返すと #2の補足の >上記指定以外のセルでは全て'textboxの文字は黒文字 を読み飛ばしていました、すみません 修正して見ましたので、試してみてください Private Sub Worksheet_SelectionChange(ByVal Target As Range) '変数の設定 Dim C As Variant 'textbox文字に対しての色番号を配列で設定する為用 Dim i As Integer '配列で設定されている色のデータを取出すためのカウンター '処理を実行する、セルの選択範囲を指定(Intersect メソッド) '指定範囲以外は処理を中止する(Exit Sub) 'Intersect(選択したセル(Target)が指定した範囲(Range("e36:i40"))に無ければ(Is Nothing) 'Not を追加することにより、上の条件を否定する '選択したセルが指定した範囲に有れば処理を進める If Not Intersect(Range("e36:i40"), Target) Is Nothing Then '範囲外の処理追加のため Not を追加 Exit Sub を削除 '下の指定範囲を簡略したものが上になります 'If Intersect(Range("e36:i36,e37:i37,e38:i38,e39:i39,e40:i40"), Target) Is Nothing Then Exit Sub '選択されているセルの行数により、処理を選択する '処理内容 '色番号を 赤色:3、黒色:0 として 'Aの文字色 Bの文字色 Cの文字色 Dの文字色 Eの文字色の順で 'Split を使用し、変数C へ配列で色番号を設定している '例として C = Split("3 0 0 0 0") は 'A:赤 B:黒 C:黒 D:黒 E:黒 と文字に対しての色番号を設定している Select Case Target.Row Case 36 '選択された行数が36行目 C = Split("3 0 0 0 0") 'textbox文字の色を配列で設定 Case 37 '選択された行数が37行目 C = Split("0 3 0 0 0") Case 38 '選択された行数が38行目 C = Split("0 0 3 0 0") Case 39 '選択された行数が39行目 C = Split("0 0 0 3 0") Case 40 '選択された行数が40行目 C = Split("0 0 0 0 3") End Select '範囲外の処理を追加しました Else C = Split("0 0 0 0 0") End If '変数C に配列で設定されている '色番号を一つずつ取出し、textboxの文字を順に変更していく For i = 0 To 4 ActiveSheet.Shapes(i + 1).Select 'textboxを選択 '選択されたtextboxの文字色を設定 Selection.Font.ColorIndex = C(i) Next i Target.Select End Sub

hooper
質問者

お礼

hige_082様 大変お世話になっております。 早速試したところ問題なく出来ました。 hige_082様のスキルの高さには大変感銘を受けました。 この度は大変ありがとう御座いました。 まだまだ当方はわからないことばかりございますので また機会がありましたら宜しくお願い致します。

その他の回答 (3)

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.3

取り敢えず無駄にならなかったようで何よりです 簡単な説明を入れときました Private Sub Worksheet_SelectionChange(ByVal Target As Range) '変数の設定 Dim C As Variant 'textbox文字に対しての色番号を配列で設定する為用 Dim i As Integer '配列で設定されている色のデータを取出すためのカウンター '処理を実行する、セルの選択範囲を指定(Intersect メソッド) '指定範囲以外は処理を中止する(Exit Sub) 'Intersect(選択したセル(Target)が指定した範囲(Range("e36:i40"))に無ければ(Is Nothing)処理中止(Exit Sub) '選択したセルが指定した範囲に有れば処理を進める If Intersect(Range("e36:i40"), Target) Is Nothing Then Exit Sub '下の指定範囲を簡略したものが上になります 'If Intersect(Range("e36:i36,e37:i37,e38:i38,e39:i39,e40:i40"), Target) Is Nothing Then Exit Sub '選択されているセルの行数により、処理を選択する '処理内容 '色番号を 赤色:3、黒色:0 として 'Aの文字色 Bの文字色 Cの文字色 Dの文字色 Eの文字色の順で 'Split を使用し、変数C へ配列で色番号を設定している '例として C = Split("3 0 0 0 0") は 'A:赤 B:黒 C:黒 D:黒 E:黒 と文字に対しての色番号を設定している Select Case Target.Row Case 36 '選択された行数が36行目 C = Split("3 0 0 0 0") 'textbox文字の色を配列で設定 Case 37 '選択された行数が37行目 C = Split("0 3 0 0 0") Case 38 '選択された行数が38行目 C = Split("0 0 3 0 0") Case 39 '選択された行数が39行目 C = Split("0 0 0 3 0") Case 40 '選択された行数が40行目 C = Split("0 0 0 0 3") End Select '変数C に配列で設定されている '色番号を一つずつ取出し、textboxの文字を順に変更していく For i = 0 To 4 ActiveSheet.Shapes(i + 1).Select 'textboxを選択 '選択されたtextboxの文字色を設定 Selection.Font.ColorIndex = C(i) Next i Target.Select End Sub textboxの選択の順番はシートにtextboxを設置した順番です 文字を見て判断している訳ではないので、選択される順番に 文字を入れ替えるか、シート上のtextboxをすべて消して Aから順に設定しなおしてください 本来はtextboxの名前を固定するか、取得してから処理するとよいのですが コードが長く複雑になるので・・・

hooper
質問者

お礼

hige_082様 大変お世話になっております。 ご丁寧な回答ありがとうございました。 当方勉強不足にて大変お手数をお掛けしました。 回答内容を試して活用したいと思います。 また機会がありましたら宜しくお願い致します。

hooper
質問者

補足

hige_082様 大変お世話になっております。 回答を頂きましてから いろいろ試してみましたが どうしても“指定した範囲(Range("e36:i40"))に無ければ(Is Nothing)処理中止(Exit Sub)”にて 指定範囲以外にて色が赤から黒に戻りません。 何卒お教え願います。

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

#1の補足から >sheetに図(写真)で 図が写真であるなら無理です excelで写真の加工が出来ないため >実際にはⒶの記号で 肝心な部分が化けていて分りません >背景塗りつぶしなしの黒文字ⒶⒷⒸ三つ作成し 推測でテキストボックスの文字の色を変更するならば 次のような感じですかね 'textboxの文字色変更 'sheetModuleへ Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim C As Variant Dim i As Integer If Intersect(Range("a1:a5"), Target) Is Nothing Then Exit Sub Select Case Target.Row Case 1 C = Split("0 0 0") Case 2 C = Split("3 0 0") Case 3 C = Split("0 3 0") Case 4 C = Split("0 0 3") Case 5 C = Split("0 0 0") End Select For i = 0 To 2 ActiveSheet.Shapes(i + 1).Select Selection.Font.ColorIndex = C(i) Next i Target.Select End Sub これも無駄になるような気が・・・

hooper
質問者

お礼

hige_082様 その節は大変お世話になりました。 質問締め切り後に追加の質問がありましたので 下記の通り新たに質問させて頂きましたので 何卒ご回答願います。 宜しくお願い致します。 質問:エクセルVBAにて指定範囲以外処理時複数セルの場合エラーになる。

hooper
質問者

補足

hige_082様 大変お世話になっております。 “無駄になるような”とはとんでもありません。 当初とはやや違いますが出来ることが 'textboxにて文字色変更が確認され 感激しております。 ありがとうございました。 基本動作確認されたところで 応用して使用したところ コード理解不足にて応用が利きません。 お手数ですが教えていただけないでしょうか? 応用型 セルe36からi36の場合に丸Aの黒文字から赤文字に変化し セルe37からi37の場合に丸Bの黒文字から赤文字に変化し セルe38からi38の場合に丸Cの黒文字から赤文字に変化し セルe39からi39の場合に丸Dの黒文字から赤文字に変化し セルe40からi40の場合に丸Eの黒文字から赤文字に変化し 上記指定以外のセルでは全て'textboxの文字は黒文字 'textboxにて文字は丸の中にABCDEです。 前回の文字化けは大変失礼しました。 何卒宜しくお願い致します。

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.1

漠然としすぎてなんだか分りません 指定オブジェクトとは何??範囲広すぎ(book、sheet、cell・・・などなど) せめて、例でも挙げてくれないと 訳分らんので、訳分らん回答を一つ sheetに図形を三つ作成しといて そのsheetModuleに下記のコード設定して セルA1~A3を適当に選んで 図形の色が変わるから Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Integer If Intersect(Range("a1:a3"), Target) Is Nothing Then Exit Sub i = ActiveSheet.Shapes(Target.Row).Fill.ForeColor.SchemeColor If i = 9 Then i = 10 ElseIf i = 10 Then i = 12 ElseIf i = 12 Then i = 13 Else i = 9 End If ActiveSheet.Shapes(Target.Row).Fill.ForeColor.SchemeColor = i End Sub 図形の部分をその指定オブジェクトとやらに置き換えれば出来るかもよ

hooper
質問者

お礼

hige_082様 度々恐縮ですが再度問題が発生し解決方法がわかりません。 大変お手数なのは重々承知しておりますが 下記の内容にて新たに質問をさせて頂きましたので 何卒ご回答を宜しくお願い致します。 エクセルVBAにてプログラムされているシートに別のシートからマクロのモジュールにて貼り付けるとエラーになります。

hooper
質問者

補足

hige_082様 大変お世話になっております。 早速の回答ありがとうございました。 ご指摘の通り当方勉強不足にて 漠然とした質問にて大変お手数をお掛けしております。 具体例を挙げさせて頂くと sheetに図(写真)で、実際にはⒶの記号で背景塗りつぶしなしの黒文字ⒶⒷⒸ三つ作成し、セルA1では通常通り黒でセルA2になるとⒶの黒文字が赤文字になり、セルA3になるとⒶの赤文字が黒文字になりⒷの黒文字が赤文字になり、更にセルA4になるとⒷの赤文字が黒文字になりⒸの黒文字が赤文字になり、セルA5になるⒸの赤文字が黒文字になるという具合です。 セルA1:図Ⓐ=黒・図Ⓑ=黒・図Ⓒ=黒 セルA2:図Ⓐ=赤・図Ⓑ=黒・図Ⓒ=黒 セルA3:図Ⓐ=黒・図Ⓑ=赤・図Ⓒ=黒 セルA4:図Ⓐ=黒・図Ⓑ=黒・図Ⓒ=赤 セルA5:図Ⓐ=黒・図Ⓑ=黒・図Ⓒ=黒 何卒宜しくお願い致します。 尚、sheetに図形を三つ作成しといて そのsheetModuleに下記のコード設定し セルA1~A3を適当に選んだところ 実行時エラー‘70’:書き込みできません。 にて確認できまでした。 当方スキル不足にて恐縮です。

関連するQ&A

専門家に質問してみよう