ダブルクリックされたセルの色を別のセルにセットする・・・
そんな必要が生じたので VBA でコーディングしてみました。
＃ 色付け関連の VBA はすでに経験済みなので難しくなかったのですが、
印刷処理で手間取りました。
今回はＡ３サイズでの印刷することを前提にしていましたが。
宅内にはＡ４対応のプリンターしかありません。
印刷テストを現地で行ったところ、うまくいきませんでした・・・
横１ページ・縦２ページに合わせて印刷するのですが、
思った位置に改ページを挿入できませんでした。
行の高さと列の幅を大きくして、思いどおりになりました・・・ (^-^;
閑話休題・・・
今回は久しぶりに Excel VBA のチップス・・・
Excel での色の取得とセットです。
まずは実例をご覧ください。
これが元のシート・・・
右側にある色の付いたセル（表示は 1～10）をダブルクリックすると
そのセルの色を１行おきの色にします。
（実際は 2行 1セットなので、1セットおきの色にします）
うまく説明できないので、アニメーション GIF で実際の動きをご覧ください。
右側の縦に並んだ色付きのセルをダブルクリックすると
左側の行にその色をセットしています・・・
（百聞は一見に如かず、ですよね）
ここでのポイントは３つ。
１．セルのダブルクリック・イベントを捕捉する
２．ダブルクリックされたセルの背景色を取得する
３．２行１セットで、１セットおきに色を付ける
順に説明していきます・・・
１．セルのダブルクリック・イベントを捕捉する
Worksheet_BeforedoubleClick を使います。
コードは次のとおりです・・・（実際のコードなので、サンプルとしては分かりにくいかも・・・）
▼▼ ここからがコード -----------------------------------------------------------------
' ---セル・ダブルクリック時: 色選択エリア: 1セットおきの色を変える
Private Sub Worksheet_BeforedoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim colorNo As Integer
If (ActiveCell.Row >= 12 And ActiveCell.Row <= 31) And _
(ActiveCell.Column = 27) Then
colorNo = (ActiveCell.Row / 2) - 5
Call Module_Coloring.prc_Alternate_Color(colorNo)
End If
End Sub
▲▲ ここまでがコード -----------------------------------------------------------------
「色選択エリア」（行は 12 ～ 31、列は 27。 2行分をセル結合している）上でダブルクリックされたら
標準モジュール Module_Coloring のサブルーチン prc_Alternate_Color を呼び出しています。
サブルーチンの引数は、ダブルクリックされたセルの色番号（1 ～ 10）です。
２．ダブルクリックされたセルの背景色を取得する
標準モジュール Module_Coloring 内に２つのサブルーチンを作っています。
１つ目は prc_Alternate_Color。
引数は colorNo（整数、選択された色番号）。
シート中のコードから呼び出されるため、Public にしています。
２つ目は関数 fnc_Get_RGB です。
引数は colorNo（整数、選択された色番号）、
戻り値（リターンコード）は文字列（色を 16進数であらわしたもの）です。
▼▼ ここからがコード -----------------------------------------------------------------
' --- １行おきの色を変える
Public Sub prc_Alternate_Color(ByVal colorNo As Integer)
' --- 選択された色の RGB 値を取得
Dim myRGB As String
myRGB = fnc_Get_RGB(colorNo)
Range("選択された色").Interior.Color = myRGB
' ---
Dim myRow As Integer
' --- 月の前半
For myRow = 12 To 56
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 25)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 25)) _
.Interior.Color = myRGB
End If
Next
' --- 月の後半
For myRow = 72 To 116
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 26)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 26)) _
.Interior.Color = myRGB
End If
Next
End Sub
▲▲ ここまでがコード -----------------------------------------------------------------
シートでは横方向に１か月間の日付（1日～31日など）が広がっています。
最終的には紙に印刷します。
用紙サイズの関係で、
月の前半（1日～15日、行では 12～56）と
月の後半（16日～月末日、、行では 72～116））の２段に分けています。
肝心なのは [特定の範囲].Interior.Color = myRGB です。
myRGB（文字列型の変数）には 16進数の色が入ります。
その値を取得するのが、下の関数 fnc_Get_RGB です。
▼▼ ここからがコード -----------------------------------------------------------------
' --- 指定されたセルのRGB色を取得
Private Function fnc_Get_RGB(ByVal colorNo As Integer) As String
Dim myRGB As String
' --- Excel VBA では、R-G-Bではなく B-G-R
Select Case colorNo
Case Is = 1
myRGB = "&hBCE4D8"
Case Is = 2
myRGB = "&hB4D5FC"
Case Is = 3
myRGB = "&hF1D9C5"
Case Is = 4
myRGB = "&hB7B8E6"
Case Is = 5
myRGB = "&hD9D9D9"
Case Is = 6
myRGB = "&hE8DEB7"
Case Is = 7
myRGB = "&hDAC0CC"
Case Is = 8
myRGB = "&hFFFFCC"
Case Is = 9
myRGB = "&h99FFFF"
Case Is = 10
myRGB = "&h99FFCC"
End Select
' ---
fnc_Get_RGB = myRGB
End Function
▲▲ ここまでがコード -----------------------------------------------------------------
上の関数 fnc_Get_RGB でのポイントは２つ。
① ColorIndex では使える色が 56種類に限定されます。
今回はそれ以外の色を扱いたいので RGB 値を使います。
② Office の VBA では、色は（他の言語と違い）R-G-B（赤-緑-青）の順ではなく
B-G-R (青-緑-赤）の順で指定します。
この B-G-R 値を得るために、フリーウェア Color Picker（カラーピッカー） の力を借りています。
Color Picker を使うと、マウスポインターの指している場所の色（RGB の値）を簡単に取得できるからです。
Color Picker は Vector よりダウンロードできます。
※ Color Picker の使い方は簡単ですが、説明すると長くなるので今回は割愛・・・
使い方は別記事で紹介する予定です。
関数 fnc_Get_RGB は、与えられた ColorNo に応じて
16進数の RGB（実際には BGR）の値（文字列）を返します。
myRGB = "&hBCE4D8" のような記述がそれです。
３．２行１セットで、１セットおきに色を付ける
上でご紹介している、サブルーチン prc_Alternate_Color 内の記述をご覧ください。
' --- 月の前半
For myRow = 12 To 56
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 25)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 25)) _
.Interior.Color = myRGB
End If
Next
ここでは、月の前半（行 12～56）を１行ずつループして
１行おきに（実際は２行が１セットなので、１セットおきに）色を付けます。
１セットおきにするために、行番号が４で割り切れるかどうかを判断しています。
割り切れる場合は、その行とt次の１行に色を付けています。
※ ごめんなさい、サンプルとしては分かりにくいものになっています。
この記事のために別途シートを設計して VBA を書く余裕がないので
手抜きしています・・・
---------------------------------------------------------
ブログ記事についてのお問い合わせは「質疑応答 掲示板」で・・・
＃ ご質問にはできる限りお答えしています。
ただし、お名前（本名の姓 and/or 名）を書いていただいた場合に
限らせていただきます。
ここをクリックして、北窓舎のサイトにもお立ち寄りください・・・
そんな必要が生じたので VBA でコーディングしてみました。
＃ 色付け関連の VBA はすでに経験済みなので難しくなかったのですが、
印刷処理で手間取りました。
今回はＡ３サイズでの印刷することを前提にしていましたが。
宅内にはＡ４対応のプリンターしかありません。
印刷テストを現地で行ったところ、うまくいきませんでした・・・
横１ページ・縦２ページに合わせて印刷するのですが、
思った位置に改ページを挿入できませんでした。
行の高さと列の幅を大きくして、思いどおりになりました・・・ (^-^;
閑話休題・・・
今回は久しぶりに Excel VBA のチップス・・・
Excel での色の取得とセットです。
まずは実例をご覧ください。
これが元のシート・・・
右側にある色の付いたセル（表示は 1～10）をダブルクリックすると
そのセルの色を１行おきの色にします。
（実際は 2行 1セットなので、1セットおきの色にします）
うまく説明できないので、アニメーション GIF で実際の動きをご覧ください。
右側の縦に並んだ色付きのセルをダブルクリックすると
左側の行にその色をセットしています・・・
（百聞は一見に如かず、ですよね）
ここでのポイントは３つ。
１．セルのダブルクリック・イベントを捕捉する
２．ダブルクリックされたセルの背景色を取得する
３．２行１セットで、１セットおきに色を付ける
順に説明していきます・・・
１．セルのダブルクリック・イベントを捕捉する
Worksheet_BeforedoubleClick を使います。
コードは次のとおりです・・・（実際のコードなので、サンプルとしては分かりにくいかも・・・）
▼▼ ここからがコード -----------------------------------------------------------------
' ---セル・ダブルクリック時: 色選択エリア: 1セットおきの色を変える
Private Sub Worksheet_BeforedoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim colorNo As Integer
If (ActiveCell.Row >= 12 And ActiveCell.Row <= 31) And _
(ActiveCell.Column = 27) Then
colorNo = (ActiveCell.Row / 2) - 5
Call Module_Coloring.prc_Alternate_Color(colorNo)
End If
End Sub
▲▲ ここまでがコード -----------------------------------------------------------------
「色選択エリア」（行は 12 ～ 31、列は 27。 2行分をセル結合している）上でダブルクリックされたら
標準モジュール Module_Coloring のサブルーチン prc_Alternate_Color を呼び出しています。
サブルーチンの引数は、ダブルクリックされたセルの色番号（1 ～ 10）です。
２．ダブルクリックされたセルの背景色を取得する
標準モジュール Module_Coloring 内に２つのサブルーチンを作っています。
１つ目は prc_Alternate_Color。
引数は colorNo（整数、選択された色番号）。
シート中のコードから呼び出されるため、Public にしています。
２つ目は関数 fnc_Get_RGB です。
引数は colorNo（整数、選択された色番号）、
戻り値（リターンコード）は文字列（色を 16進数であらわしたもの）です。
▼▼ ここからがコード -----------------------------------------------------------------
' --- １行おきの色を変える
Public Sub prc_Alternate_Color(ByVal colorNo As Integer)
' --- 選択された色の RGB 値を取得
Dim myRGB As String
myRGB = fnc_Get_RGB(colorNo)
Range("選択された色").Interior.Color = myRGB
' ---
Dim myRow As Integer
' --- 月の前半
For myRow = 12 To 56
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 25)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 25)) _
.Interior.Color = myRGB
End If
Next
' --- 月の後半
For myRow = 72 To 116
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 26)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 26)) _
.Interior.Color = myRGB
End If
Next
End Sub
▲▲ ここまでがコード -----------------------------------------------------------------
シートでは横方向に１か月間の日付（1日～31日など）が広がっています。
最終的には紙に印刷します。
用紙サイズの関係で、
月の前半（1日～15日、行では 12～56）と
月の後半（16日～月末日、、行では 72～116））の２段に分けています。
肝心なのは [特定の範囲].Interior.Color = myRGB です。
myRGB（文字列型の変数）には 16進数の色が入ります。
その値を取得するのが、下の関数 fnc_Get_RGB です。
▼▼ ここからがコード -----------------------------------------------------------------
' --- 指定されたセルのRGB色を取得
Private Function fnc_Get_RGB(ByVal colorNo As Integer) As String
Dim myRGB As String
' --- Excel VBA では、R-G-Bではなく B-G-R
Select Case colorNo
Case Is = 1
myRGB = "&hBCE4D8"
Case Is = 2
myRGB = "&hB4D5FC"
Case Is = 3
myRGB = "&hF1D9C5"
Case Is = 4
myRGB = "&hB7B8E6"
Case Is = 5
myRGB = "&hD9D9D9"
Case Is = 6
myRGB = "&hE8DEB7"
Case Is = 7
myRGB = "&hDAC0CC"
Case Is = 8
myRGB = "&hFFFFCC"
Case Is = 9
myRGB = "&h99FFFF"
Case Is = 10
myRGB = "&h99FFCC"
End Select
' ---
fnc_Get_RGB = myRGB
End Function
▲▲ ここまでがコード -----------------------------------------------------------------
上の関数 fnc_Get_RGB でのポイントは２つ。
① ColorIndex では使える色が 56種類に限定されます。
今回はそれ以外の色を扱いたいので RGB 値を使います。
② Office の VBA では、色は（他の言語と違い）R-G-B（赤-緑-青）の順ではなく
B-G-R (青-緑-赤）の順で指定します。
この B-G-R 値を得るために、フリーウェア Color Picker（カラーピッカー） の力を借りています。
Color Picker を使うと、マウスポインターの指している場所の色（RGB の値）を簡単に取得できるからです。
Color Picker は Vector よりダウンロードできます。
※ Color Picker の使い方は簡単ですが、説明すると長くなるので今回は割愛・・・
使い方は別記事で紹介する予定です。
関数 fnc_Get_RGB は、与えられた ColorNo に応じて
16進数の RGB（実際には BGR）の値（文字列）を返します。
myRGB = "&hBCE4D8" のような記述がそれです。
３．２行１セットで、１セットおきに色を付ける
上でご紹介している、サブルーチン prc_Alternate_Color 内の記述をご覧ください。
' --- 月の前半
For myRow = 12 To 56
If ((myRow Mod 4) = 0) Then
Range(Cells(myRow, 10), Cells(myRow, 25)) _
.Interior.Color = myRGB
Range(Cells(myRow + 1, 10), Cells(myRow + 1, 25)) _
.Interior.Color = myRGB
End If
Next
ここでは、月の前半（行 12～56）を１行ずつループして
１行おきに（実際は２行が１セットなので、１セットおきに）色を付けます。
１セットおきにするために、行番号が４で割り切れるかどうかを判断しています。
割り切れる場合は、その行とt次の１行に色を付けています。
※ ごめんなさい、サンプルとしては分かりにくいものになっています。
この記事のために別途シートを設計して VBA を書く余裕がないので
手抜きしています・・・
---------------------------------------------------------
ブログ記事についてのお問い合わせは「質疑応答 掲示板」で・・・
＃ ご質問にはできる限りお答えしています。
ただし、お名前（本名の姓 and/or 名）を書いていただいた場合に
限らせていただきます。
ここをクリックして、北窓舎のサイトにもお立ち寄りください・・・
