[VBA]サイトのテーマカラーを調整するツール

eh657883

はじめに

今までの自分は、エクセルやHTMLでツールを作成する際に、使用する色を一色ずつ適当にサイトから拾っていたため、毎回統一感のない仕上がりになっていた。

かつ、色の微調整に多くの時間を割いており、これでは非効率だということで、簡単にサイトのカラーを設定できるツールを作成した。

 

ツールを作成したといっても、外部サイトから拝借したカラーパレットをもとに、せこせことVBAで色を変更しているだけである。

とはいえ、要素ごとの色を「あーでもないこーでもない」と試行錯誤するよりは格段に効率的になったし、今までデザインについて壊滅的だった自分に少しだけ自身が持てたような気がする。

イメージ

 

 

ソースコード

Option Explicit

' 色変更
Public Sub ChangeColors()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    With ws
        
        ' 背景
        Dim color As Long
        color = ConvertColorHexToDex(.Range("F23").Value)
                
        color = GetBackColor(.Range("F23").Value)
        .Range("2:9").Interior.color = color
        .Range("20:1000").Interior.color = color
        .Range("A:B").Interior.color = color
        .Range("I:Z").Interior.color = color
        
        ' タイトル
        color = ConvertColorHexToDex(.Range("F23").Value)
        .Range("1:1").Interior.color = color
        
        ' 見出し
        color = ConvertColorHexToDex(.Range("F27").Value)
        .Range("B4,B6").Font.color = color
        
        
        ' ヘッダー
        color = ConvertColorHexToDex(.Range("F31").Value)
        .Range("C10:H10").Interior.color = color
        
        ' テーブル値
        color = ConvertColorHexToDex(.Range("F32").Value)
        .Range("C11:C19").Interior.color = color
        .Range("F11:F19").Interior.color = color
        .Range("G11:G19").Interior.color = color
        .Range("H11:H19").Interior.color = color

        ' テーブル罫線
        color = ConvertColorHexToDex(.Range("F30").Value)
        .Range("C10:H19").Borders.color = color

        color = ConvertColorHexToDex(.Range("F28").Value)
        .Shapes("ExecButton").Fill.ForeColor.RGB = color
     End With
End Sub

' カラーコード 16進 → 10進数
Private Function ConvertColorHexToDex(source As String) As Long
    Dim r, g, b As String
    r = CLng(Val("&H" & Mid(source, 2, 2)))
    g = CLng(Val("&H" & Mid(source, 4, 2)))
    b = CLng(Val("&H" & Mid(source, 6, 2)))
    ConvertColorHexToDex = RGB(r, g, b)
End Function

' 極力白に近い、プライマリーカラー
Private Function GetBackColor(source As String) As Long
    Dim r, g, b As String
    r = CLng(Val("&H" & Mid(source, 2, 2)))
    g = CLng(Val("&H" & Mid(source, 4, 2)))
    b = CLng(Val("&H" & Mid(source, 6, 2)))
    
    Dim rate As Double
    rate = 0.95
    
    r = ((1 - rate) * r) + 255 * rate
    g = ((1 - rate) * g) + 255 * rate
    b = ((1 - rate) * b) + 255 * rate
        
    GetBackColor = RGB(CLng(r), CLng(g), CLng(b))
End Function

 

参考サイト

カラー（カラーパレット）｜デジタル庁デザインシステムβ版

Color Generator – Kigen