データベース領域に一行置きに横縞の色を付ける
システム概要
ダウンロードしたファイルを開くとSheet1に上図の③④で示しすデータベース領域がセットしています。
上図の①と②はそれぞれイメージコントロールを配置しインターネットから無料で使用できるイメージ画像をコピーして貼り付けてあります。
①は、クリックしたときのイベントプロシージャにデータベース領域がどこにあるか調べて、そのデータ領域が見やすくなるよう一行置きに色を付けるためのコードを書き込んでいます。
具体的には、クリックすると下図のような縞模様の色を指定するフォームが開きます
フォームの中から、付けたい色をオプションボタンをクリックすると、データ範囲に一行置きに色を付けます。
VBAでは色を付けるコードはColorIndexで番号を指定する方法とColorにRGB関数で指定する方法があります。ここでは表を見やすくする色としては個人的な趣味趣向でこのような色が適当にセットしています。
（ここでは薄い藤色で、24を指定しています）
色指定で最後の「薄い灰色」だけはVBA色パレットのColorIndexには指定番号がついてないので
②は、クリックしたときのイベントプロシージャに、①で付けた色を消して初期状態にするコードを書き込んでいます
システムの基本動作
前準備
● 動作を開始するボタンの代わりにイメージオブジェクトを２個用意しそれぞれ、イメージ１は動作を開始するボタン、イメージ２は動作をやり直すボタンとしています。
●シートの適当な位置のセルを起点とした５列15行程度の表に適当なデータを書き込んで置きます。
※データ領域は空白行や空白列を含まないように、又一番最初の行は項目行になるようにセットします。
データの領域に一行置きに色を付けるサブプロシージャ（simasima）
※このシステムでメインとなる動作でイメージ１のクリックイベントプロシージャの中から呼び出しします。
Sub simasimaの引数説明
第一引数 GMaxには、データベース領域の最大データ行数をもらいます
第二引数 RMaxには、データベース領域の最大列数をもらいます
第三引数 dataは０と１の二つのデータを持つ配列でdata(0)にはデータベース先頭セルの行番号data(1)にはデータベース先頭セルの列番号をもらいます。
第四引数 iroには、指定する色のColorIndex番号をもらいます。
‘データベース範囲に縞模様を付ける
Dim r As Integer
Dim gyou As Integer
Dim retu As Integer
Dim p As Integer
‘
gyou = data(0)
retu = data(1)
‘データベースの色を消しておく
ActiveSheet.Cells(gyou, retu).CurrentRegion.Offset(1).Interior.ColorIndex = 0
‘一行置きに色を付けるメインコード
For r = 2 To GMax Step 2
If iro = 240 Then
’RGB()関数使用の時
下記のコードはセル範囲に色を付ける具体例を下図で読み解いてください。
ActiveSheet.Range(Cells(gyou + r, retu), Cells(gyou + r, retu + RMax – 1)) _
.Interior.Color = RGB(iro, iro, iro)
Else
’ColorIndex番号の時
ActiveSheet.Range(Cells(gyou + r, retu), Cells(gyou + r, retu + RMax – 1)) _
.Interior.ColorIndex = iro
End If
Next r
End Sub
RGB関数でセル範囲に色を付ける具体例
全てのコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
Private Sub Image2_Click() '縞消す 'データベースの先頭位置取得(0=先頭の行位置 1=先頭の列位置) data = dataiti ActiveSheet.Cells(data(0), data(1)).CurrentRegion.Offset(1).Interior.ColorIndex = 0 End Sub Private Sub Image1_Click() Dim gyouMax As Integer Dim retuMax As Integer Dim data As Variant 'Dim kakuninn As Integer Dim reslt As Variant 'データベースの先頭位置取得(0=先頭の行位置 1=先頭の列位置) data = dataiti If data(0) = -1 Then MsgBox "シートのセル範囲、100行100列以内にデータベースがありません" Exit Sub Else 'MsgBox data(0) & "行" & data(1) & "列目にデータベースを発見しました。" gyouMax = ActiveSheet.Cells(data(0), data(1)).CurrentRegion.Rows.Count - 1 retuMax = ActiveSheet.Cells(data(0), data(1)).CurrentRegion.Columns.Count '縞模様付ける '第三引数は模様の色インデックス,薄い黄色19、薄い水色34、薄い緑色35、薄いピンク38、薄い藤色24 UserForm1.Show reslt = UserForm1.selectColor.Caption If reslt <> "" Then Call simasima(gyouMax, retuMax, data, reslt) End If End If End Sub Sub simasima(GMax As Integer, RMax As Integer, data As Variant, iro As Variant) 'データベース範囲に縞模様を付ける Dim r As Integer Dim gyou As Integer Dim retu As Integer Dim p As Integer ' gyou = data(0) retu = data(1) 'データベースの色を消しておく ActiveSheet.Cells(gyou, retu).CurrentRegion.Offset(1).Interior.ColorIndex = 0 For r = 2 To GMax Step 2 If iro = 240 Then '薄い灰色だけColorIndexが無いのでRGB()でセットしています。 ActiveSheet.Range(Cells(gyou + r, retu), Cells(gyou + r, retu + RMax - 1)) _ .Interior.Color = RGB(iro, iro, iro) Else ActiveSheet.Range(Cells(gyou + r, retu), Cells(gyou + r, retu + RMax - 1)) _ .Interior.ColorIndex = iro End If Next r End Sub Function dataiti() As Variant 'データベースの先頭を１００行１００列以内でデータ位置を調べる '先頭データの行位置と列位置を返す（無ければ-1を返す） Dim r As Integer Dim i As Integer Dim datazahyou(1) As Variant 'データベース把握 For r = 1 To 100 For i = 1 To 100 If Len(ActiveSheet.Cells(r, i).Value) > 0 Then datazahyou(0) = ActiveSheet.Cells(r, i).Row datazahyou(1) = ActiveSheet.Cells(r, i).Column dataiti = datazahyou Exit Function Else datazahyou(0) = -1 datazahyou(1) = -1 End If Next i Next r dataiti = datazahyou End Function |
色を指定するフォーム
フォームのコード説明
フォームに色を指定するためのオプションボタンを６個配置。
各オプションボタンをクリックしたときの状態を記録しておくラベル（ID = ”selectionColor”）を１個用意しVisibleプロパティにFalseを指定して表示しないようにしておきます
各オプションボタンをクリックしたとき、オプションボタンのキャプションに指定した色番号をraberラベルselectionColorに記録してフォームを閉じます（unload閉じるとselectionColorのデータを参照できなくなるのでHideで閉じます。）
あとで、simasimaサブプロシージャを呼び出すときに、selectionColorに記録したデータを参照して色付けする仕組みです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
Private Sub OptionButton1_Click() selectColor.Caption = 19 OptionButton1.Value = False Me.Hide End Sub Private Sub OptionButton2_Click() selectColor.Caption = 34 OptionButton2.Value = False Me.Hide End Sub Private Sub OptionButton3_Click() selectColor.Caption = 35 OptionButton3.Value = False Me.Hide End Sub Private Sub OptionButton4_Click() selectColor.Caption = 38 OptionButton4.Value = False Me.Hide End Sub Private Sub OptionButton5_Click() selectColor.Caption = 24 OptionButton5.Value = False Me.Hide End Sub Private Sub OptionButton6_Click() '薄い灰色だけColorIndexが無いのでRGB(240,240,240)でセットする selectColor.Caption = 240 OptionButton6.Value = False Me.Hide End Sub |
ダウンロード
ファイルのダウンロードは下記から
コメント