VBAサンプル集
カラーのコード取得(256RGB⇔16進変換)

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2020-04-27

カラーのコード取得(256RGB⇔16進変換)


WEB制作等で使用する16進のFFFFFFと、RGB(255,255,255)の変換をワークシートで行います。


10進で指定、16進で指定、スクロールバーで指定、
そして、セルの背景色・文字色を直接指定することができるようにしています。

指定した値が、直ちにセルに反映する為、いろいろと色を選定する時の参考になると思います。

カラーのコード取得のシートレイアウト

以下がワークシートのイメージです。

VBA マクロ  カラーのコード取得

名前定義



参照範囲 名前
C2 サンプル
F11 背景HEX
F10 背景RGB
D8 背景青10
E8 背景青16
D6 背景赤10
E6 背景赤16
D7 背景緑10
E7 背景緑16
M11 文字HEX
M10 文字RGB
K8 文字青10
L8 文字青16
K6 文字赤10
L6 文字赤16
K7 文字緑10
L7 文字緑16

スクロールバー

VBA マクロ  カラーのコード取得

以下がオブジェクト名になります。
scb背景赤
scb背景緑
scb背景青

scb文字赤
scb文字緑
scb文字青

カラーのコード取得のVBAコード

以下は、シートモジュールで作成しています。



Option Explicit

Private Sub サンプル設定()
  With Range("サンプル")
    .Interior.Color = RGB(Range("背景赤10"), Range("背景緑10"), Range("背景青10"))
    .Font.Color = RGB(Range("文字赤10"), Range("文字緑10"), Range("文字青10"))
  End With
  Range("背景RGB") = "(" & Range("背景赤10") & ", " & Range("背景緑10") & ", " & Range("背景青10") & ")"
  Range("背景HEX") = Range("背景赤16") & Range("背景緑16") & Range("背景青16")
  Range("文字RGB") = "(" & Range("文字赤10") & ", " & Range("文字緑10") & ", " & Range("文字青10") & ")"
  Range("文字HEX") = Range("文字赤16") & Range("文字緑16") & Range("文字青16")
End Sub

Private Sub scb背景赤_Change()
  Call ScrollBarChange(scb背景赤)
End Sub
Private Sub scb背景緑_Change()
  Call ScrollBarChange(scb背景緑)
End Sub
Private Sub scb背景青_Change()
  Call ScrollBarChange(scb背景青)
End Sub
Private Sub scb文字赤_Change()
  Call ScrollBarChange(scb文字赤)
End Sub
Private Sub scb文字緑_Change()
  Call ScrollBarChange(scb文字緑)
End Sub
Private Sub scb文字青_Change()
  Call ScrollBarChange(scb文字青)
End Sub

Private Sub ScrollBarChange(ByRef aScrollBar As Variant)
  Application.EnableEvents = False
  Dim sObjName As String
  sObjName = Mid(aScrollBar.Name, 4)
  Range(sObjName & "10") = aScrollBar.Value
  Range(sObjName & "16") = Right("00" & hex(aScrollBar.Value), 2)
  Call サンプル設定
  Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Integer
  Dim strHex1 As Long, strHex2 As Long
  Dim lngColor As Long
  Application.EnableEvents = False
  Select Case Target.Cells(1, 1).Address
    Case Range("サンプル").Address
      Application.ScreenUpdating = False
      lngColor = Range("サンプル").Interior.Color
      scb背景青.Value = Int(lngColor / 256 / 256)
      scb背景緑.Value = Int((lngColor - (scb背景青.Value * 256 * 256)) / 256)
      scb背景赤.Value = lngColor - (scb背景青.Value * 256 * 256) - (scb背景緑.Value * 256)
      lngColor = Range("サンプル").Font.Color
      scb文字青.Value = Int(lngColor / 256 / 256)
      scb文字緑.Value = Int((lngColor - (scb文字青.Value * 256 * 256)) / 256)
      scb文字赤.Value = lngColor - (scb文字青.Value * 256 * 256) - (scb文字緑.Value * 256)
      Application.ScreenUpdating = True
    Case Range("背景赤10").Address
      scb背景赤.Value = Range("背景赤10")
      Call サンプル設定
    Case Range("背景緑10").Address
      scb背景緑.Value = Range("背景緑10")
      Call サンプル設定
    Case Range("背景青10").Address
      scb背景青.Value = Range("背景青10")
      Call サンプル設定
    Case Range("文字赤10").Address
      scb文字赤.Value = Range("文字赤10")
      Call サンプル設定
    Case Range("文字緑10").Address
      scb文字緑.Value = Range("文字緑10")
      Call サンプル設定
    Case Range("文字青10").Address
      scb文字青.Value = Range("文字青10")
      Call サンプル設定
    Case Range("背景赤16").Address
      Call ValueChange(scb背景赤)
    Case Range("背景緑16").Address
      Call ValueChange(scb背景緑)
    Case Range("背景青16").Address
      Call ValueChange(scb背景青)
    Case Range("文字赤16").Address
      Call ValueChange(scb文字赤)
    Case Range("文字緑16").Address
      Call ValueChange(scb文字緑)
    Case Range("文字青16").Address
      Call ValueChange(scb文字青)
  End Select
  Application.EnableEvents = True
End Sub

Private Sub ValueChange(ByRef aScrollBar As Variant)
  Dim sObjName As String
  sObjName = Mid(aScrollBar.Name, 4)
  Range(sObjName & "16") = StrConv(Range(sObjName & "16"), vbUpperCase)
  Dim i As Integer
  i = fnc16to10(Range(sObjName & "16"))
  If i >= 0 Then
    aScrollBar.Value = fnc16to10(Range(sObjName & "16"))
    Call サンプル設定
  Else
    Range(sObjName & "16").Select
  End If
End Sub

Private Function fnc16to10(ByRef rng As Range) As Integer
  If Len(rng.Value) <> 2 Then
    fnc16to10 = -1
    Exit Function
  End If
  On Error Resume Next
  fnc16to10 = CInt("&H" & rng.Value)
  If Err Then
    fnc16to10 = -1
  End If
  On Error GoTo 0
End Function

スクロールバーのオブジェクトの取得が少々回りくどい方法を取っています。
OLEObjects("名称")
このような指定方法では、.Valueが取得できずにエラーとなってしまいます。
OLEObjects("名称").Value
その為、各イベントの中でオブジェクトを直接指定するようにしているため、VBAが回りくどい記述になっています。

カラーのコード取得の解説

VBAコード自体は難しいものではありませんが、
名前定義を始めとしたシートの設定が結構ありますので、
サンプルをダウンロードできるようにしておきました。

サンプルのダウンロード

このままでも使えますが、
むしろ、VBAの勉強も兼ねていろいろと変更して見てください。



同じテーマ「マクロVBAサンプル集」の記事

ユーザー定義関数でフリガナを取得する(GetPhonetic)
ユーザー定義関数でハイパーリンクのURLを取得(Hyperlink)
カラーのコード取得(256RGB⇔16進変換)
時刻になったら音を鳴らして知らせる(OnTime)
指定文字、指定数式でジャンプ機能(Union)
「値の貼り付け」をショートカットに登録(OnKey)
「セルの結合」をショートカットに登録(OnKey)
半角カナのみ全角カナに変換する
計算式の元となる数値定数を消去する(Precedents)
Beep音で音楽(Beep,Sleep)
日付の検索(配列の使用)


新着記事NEW ・・・新着記事一覧を見る

Variantの数値型と文字列型の比較|エクセル雑感(7月1日)
VBAのVariant型について|VBA技術解説(6月30日)
VBAのString型の最大文字数について|エクセル雑感(6月20日)
VBAで表やグラフをPowerPointへ貼り付ける|VBAサンプル集(6月19日)
アクティブシート以外の表示(Window)に関する設定|VBA技術解説(6月17日)
マクロ記録での色のマイナス数値について|エクセル雑感(6月16日)
ツイッター投稿用に文字数と特定文字で区切る|エクセル雑感(6月15日)
日付の謎:IsDateとCDate|エクセル雑感(6月14日)
IFステートメントの判定|エクセル雑感(6月13日)
インクリメンタルサーチの実装|ユーザーフォーム入門(6月12日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ