【ユーザーフォーム】アドイン内のセルを使って着色。さらに簡単に統一感のあるデザインにする【ExcelVBA】

これを改良。色設定をセルを使って直接ビジュアル的に行います。

シート用意

アドインの有効化On/Off

アドインブック上でアドイン有効化を解除するを実行するとそのアドインがただのブック同様の画面が開きます。

Option Explicit

Sub アドイン有効化を解除する()
  ThisWorkbook.IsAddin = False
End Sub

Sub アドインを有効化する()
  ThisWorkbook.IsAddin = True
End Sub

コードで使うために各セルに名前を付ける

各セルの背景色と文字色を普通に変更する

※今回はフォントその他のプロパティは拾ってませんが、Rangeオブジェクトに紐づくプロパティなら何でも拾えるので好き好きで設定してみてください。

アドインを有効化するを実行してシートを非表示に戻す

この処理もいちいちVBE開くのが面倒なのでボタンを挿入してマクロを登録しておきます。

メインコード

解説

先ほど付けたセルの名前はここで使われます。

Public Const ws設定 = "設定"
Const adrs背景 = "my背景"
Const adrsコントロール = "myコントロール"
Const adrsテキストBOX = "myテキストBOX"

Type～で構造化しておいて、Set色をセットするで名前付きセルの色を読み込みます。

Private Type colorUF_
  Main_Fill As Long
  Main_Text As Long
  
  Control_Fill As Long
  Control_Text As Long
  
  TextBox_Fill As Long
  TextBox_Text As Long
End Type
Private clrUF As colorUF_

Private Sub Set色をセットする()
  With ThisWorkbook.Sheets(ws設定)
    clrUF.Main_Fill = .Range(adrs背景).Interior.Color
    clrUF.Main_Text = .Range(adrs背景).Font.Color
    
    clrUF.Control_Fill = .Range(adrsコントロール).Interior.Color
    clrUF.Control_Text = .Range(adrsコントロール).Font.Color
    
    clrUF.TextBox_Fill = .Range(adrsテキストBOX).Interior.Color
    clrUF.TextBox_Text = .Range(adrsテキストBOX).Font.Color
  End With
End Sub

メインコード

Option Explicit

Public Const ws設定 = "設定"
Const adrs背景 = "my背景"
Const adrsコントロール = "myコントロール"
Const adrsテキストBOX = "myテキストBOX"


Private Type colorUF_
  Main_Fill As Long
  Main_Text As Long
  
  Control_Fill As Long
  Control_Text As Long
  
  TextBox_Fill As Long
  TextBox_Text As Long
End Type
Private clrUF As colorUF_

Public Sub UFの全コントロールのTypeNameを出力する(myUF As UserForm)
  
  Dim e As Control
  For Each e In myUF.Controls
    Debug.Print e.Name, TypeName(e)
  Next

End Sub

Public Sub UFの全コントロールを着色する(myUF As UserForm)
  Call Set色をセットする
  Call 指定コントロールを着色(myUF, clrUF.Main_Fill, clrUF.Main_Text)
  
  Dim e As Control
  For Each e In myUF.Controls
    Call 指定コントロールのフォント設定(e, "Meiryo UI", 12, True)
    
    Select Case TypeName(e)
      Case "Label", "Frame"
        Call 指定コントロールを着色(e, clrUF.Main_Fill, clrUF.Main_Text)
        
      Case "ListView4", "TextBox", "ListBox", "ComboBox"
        Call 指定コントロールを着色(e, clrUF.TextBox_Fill, clrUF.TextBox_Text, clrUF.TextBox_Text)
        
      Case "CommandButton"
        Call 指定コントロールを着色(e, clrUF.Control_Fill, clrUF.Control_Text)
    End Select
  Next

End Sub


Private Sub Set色をセットする()
  With ThisWorkbook.Sheets(ws設定)
    clrUF.Main_Fill = .Range(adrs背景).Interior.Color
    clrUF.Main_Text = .Range(adrs背景).Font.Color
    
    clrUF.Control_Fill = .Range(adrsコントロール).Interior.Color
    clrUF.Control_Text = .Range(adrsコントロール).Font.Color
    
    clrUF.TextBox_Fill = .Range(adrsテキストBOX).Interior.Color
    clrUF.TextBox_Text = .Range(adrsテキストBOX).Font.Color
  End With
End Sub


Public Sub 指定コントロールのフォント設定(myControl As Variant, _
                                           フォント As String, _
                                             サイズ As Double, _
                                      Optional Bold As Boolean)
  Rem myControlがVariantなのはMeがControlではないため
  
  With myControl.Font
    .Name = フォント
    .Size = サイズ
    .Bold = Bold
  End With
  
End Sub

Public Sub 指定コントロールを着色(myControl As Variant, _
                                     背景色, _
                                     Text_色, _
                            Optional 境界色)
  Rem myControlがVariantなのはMeがControlではないため
  
  On Error Resume Next
  With myControl
    .BackColor = 背景色
    .ForeColor = Text_色
    If IsMissing(境界色) = False Then: .BorderColor = 境界色
  End With
End Sub

ユーザーフォーム側から呼ぶ

Private Sub UserForm_Initialize()
  'ほかの処理
  Call UFの全コントロールを着色する(Me)
  
End Sub

別バージョンも使わないセル範囲に残しておいて適宜設定範囲に値と書式を貼り付けてやればデザインテーマが一瞬で変更できます。