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

質問

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

回答No.4

hige_082 · ベストアンサー

補足、お礼等を読み返すと
＃２の補足の
＞上記指定以外のセルでは全て'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

お礼

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

回答No.3

hige_082

取り敢えず無駄にならなかったようで何よりです
簡単な説明を入れときました

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の名前を固定するか、取得してから処理するとよいのですが
コードが長く複雑になるので・・・

お礼

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

補足

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

回答No.2

hige_082

＃１の補足から
＞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

これも無駄になるような気が・・・

お礼

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

補足

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

回答No.1

hige_082

漠然としすぎてなんだか分りません
指定オブジェクトとは何？？範囲広すぎ(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

図形の部分をその指定オブジェクトとやらに置き換えれば出来るかもよ

お礼

hige_082様
度々恐縮ですが再度問題が発生し解決方法がわかりません。
大変お手数なのは重々承知しておりますが
下記の内容にて新たに質問をさせて頂きましたので
何卒ご回答を宜しくお願い致します。

エクセルVBAにてプログラムされているシートに別のシートからマクロのモジュールにて貼り付けるとエラーになります。

補足

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