設定した色の濃度と暗さのバリエーションを自動生成します。
処理の関係で2つのVBAに分けました。
濃度調整の9段階＞ Sub ApplyColorShades()
A10セルの色の10%~90%をA1~A9のセルに反映
暗さ調整の9段階＞ Sub ApplyDarkerShades()
A10セルの色の10%~90%暗い色をA11~A19のセルに反映
Sub ApplyColorShades()
Dim selectedCell As Range
Dim baseColor As Long
Dim r As Long, g As Long, b As Long
Dim newColor As Long
Dim i As Integer
Dim factor As Double
Dim ws As Worksheet
' 現在のシートを取得
Set ws = ActiveSheet
' 選択範囲の最初のセルを取得
Set selectedCell = Selection.Cells(1, 1)
' 選択されたセルの塗り色を取得
baseColor = selectedCell.Interior.Color
' RGB値を分解
r = baseColor Mod 256
g = (baseColor ¥ 256) Mod 256
b = (baseColor ¥ 256 ¥ 256) Mod 256
' A1〜A9に10%〜90%の濃度の色を適用
For i = 1 To 9
' 濃度の割合を計算
factor = i * 0.1
' 新しいRGB値を計算（白に近づける）
newColor = RGB(255 - (255 - r) * factor, _
255 - (255 - g) * factor, _
255 - (255 - b) * factor)
' A列のセルに色を適用
ws.Cells(i, 1).Interior.Color = newColor
ws.Cells(i, 2).Value = "濃度 " &
Format(factor * 100, "0") & "%"
Next i
End Sub
Sub ApplyDarkerShades()
Dim selectedCell As Range
Dim baseColor As Long
Dim r As Long, g As Long, b As Long
Dim newColor As Long
Dim i As Integer
Dim factor As Double
Dim ws As Worksheet
' 現在のシートを取得
Set ws = ActiveSheet
' 選択範囲の最初のセルを取得
Set selectedCell = Selection.Cells(1, 1)
' 選択されたセルの塗り色を取得
baseColor = selectedCell.Interior.Color
' RGB値を分解
r = baseColor Mod 256
g = (baseColor ¥ 256) Mod 256
b = (baseColor ¥ 256 ¥ 256) Mod 256
' A11〜A19に10%〜90%暗い色を適用
For i = 1 To 9
' 暗さの割合を計算
factor = i * 0.1
' 新しいRGB値を計算（黒に近づける）
newColor = RGB(r * (1 - factor), _
g * (1 - factor), _
b * (1 - factor))
' A列のセルに色を適用
ws.Cells(i + 10, 1).Interior.Color = newColor
ws.Cells(i + 10, 2).Value =
"暗さ " & Format(factor * 100, "0") & "%"
Next i
End Sub
［A10］セルを任意のベースカラーで塗り潰します。
ここで、ApplyColorShades()
を実行します。
これで［A10］の色に対して 10%~90%薄い色が［A1］〜［A9］のセルに塗り潰されます。
続いて、ApplyDarkerShades()
を実行します。これで［A10］の色に対して 10%~90%濃い（暗い）色が［A11］〜［A19］のセルに塗り潰されます。
続けて処理したい場合は・・・A列に2列新規列を挿入し、［A10］セルを任意のベースカラーで塗り潰し・・・
同じように処理すればOKです。
