第147回目、指定した場所に色を塗る

○第147回目、指定した場所に色を塗る

　指定されたセルを色を付けるというマクロですが、それほどたいしたものではないという感じはします。あると便利という程度のものかもしれません。

　通常の操作で色をつけるにはどのような操作になるでしょうか。
　1.範囲を指定する。
　2.Ctrl+1でセル書式のダイアログを出す。
　3.色のタブを選ぶ。
　4.カラーパレットから色を指定する(ここでは単純な指定とします＝カラーコードで指定)。
　違う場所にも同じ色を付ける場合は、他の書式が同じであれば、書式のみのコピーとなります。
　一般的には、同じ操作を繰り返すということでしょう。
　ニーズがどのくらいかるのかということになりますが、よかったら作ってみてくださいという程度の紹介とします。

　色コードと色の対応は？
＝⇒1-56のカラーコード"、または"カラーパレットのインデックス番号"色
　 for i = 0 to 6
　　 for j = 0 to 7
　　　 Cells(4 + i , 3 + j )= i * 8 + j + 1
　　　 Cells(4 + i , 3 + j ).Interior.ColorIndex = i * 8 + j + 1
　　 next
　 next
　を動かしてセルに付いた色をみてください。

　なんだこういう仕組みだったのか
＝⇒そのとおりです。ほとんど操作マクロでできてしまいます。

　これでは面白くないので、
　1.連続処理にする(色は直前に指定したものを引き継ぐとします)
　2.色をとるという機能を入れる
　3.既に色が付いているセルには、新たな色をつけない、という選択ができる

　マクロの構造はdoループとします。
　終了は、セルの範囲指定の段階で、ESCキーとか終了キーを押した場合とします。
　色をとる場合は、色コードを指定する際に0を入力します。
　色が付いているセルをそのままにする場合は、色コードの指定の時に、コードに*をつけることで区分します。

　マクロのポイントは、
　
　1.二回目以降のセル範囲の指定
　Dim セル範囲 As Range
　On Error GoTo ErrorTrap

'色を付たいセル範囲の設定
　Set セル範囲 = Application.InputBox(Prompt:=msg02 & "セル範囲を指定してください", Default:=in_rrcc1, Left:=2, Top:=2, Type:=8)
　　in_rrcc1 = セル範囲.Address
　If errflag = 99 Then Exit Do 'ESCキーを押すとエラーになりループを抜ける
　Range(in_rrcc1).Select

ErrorTrap:
　errflag = 99
　Resume Next

2.指定した色に*が付いているか
　iro = InputBox("色コードを指定してください", , iro)
　p1 = InStr(iro, "*")
　If p1 <> 0 Then

3.色をとる
　　 Cells(gyo1 + i - 1, retu1 + j - 1).Interior.ColorIndex = xlColorIndexNone

4.色情報の指定と色を付ける(色が付いているセルには新たに色をつけない場合)
　　Range(in_rrcc2).Select
　　iro = InputBox("色コードを指定してください", , iro)
　　For Each CCC In Selection 'cells()を使わないで、指定範囲内のセルひとつずつ処理する方法
　　　iro0 = CCC.Interior.ColorIndex
　　　If iro0 = -4142 Or iro = 0 Then '-4142はセルに色が付いていないという意味
　　　　CCC.Interior.ColorIndex = iro
　　　End If
　　Next
　こんなものでしょうか。

　参考までに、系列別の色コードを掲げて置きます。
　
　"黄色系＝⇒19-36-27-6"
　"水色系＝⇒20-37-33-42-28-8"
　"ダイダイ系＝⇒40-44-45-22-46-3"
　"桃色系＝⇒38-26-7"
　"紫系＝⇒24-17-39"
　"緑系＝⇒43-4-50-10-14-31"
　"こげ茶系＝⇒9-18-53-54-30"
　"濃い紫系＝⇒13-29-21-12"
　"濃い灰色系＝⇒15-48-16"
　"群青系＝⇒41-23-32-5-55"