ExcelVBAで、ColorIndexの取得

質問

エクセルのVBAで、組み込みダイアログを使用して、色の選択が出来ないか？奮闘しています。
Application.Dialogs(xlDialogColorPalette).Show
を、使用することを考えたのですが、選択したカラーインデックスをどのように取得できるのか？判りません。どなたか詳しい方いらっしゃいましたら教えて貰えないでしょうか？よろしくお願いいたします。
エクセルのカラーパレットのインデックスナンバーの選択と取得が出来れば、どのような方法でもかまわないのですが・・・？

回答No.4

Wendy02 · ベストアンサー

#3の追伸です。

ためしに、UserForm に　CommonDialog を付けて
CommonDialog は、Office 2002? 以上には、ActiveX コントロールとして、標準的についています。

　　CommonDialog1.ShowColor

として、カラーダイアログを使ってみましたが、個人的には、便利だとは思えませんでした。
こういうやり方もあるなって程度です。

UserForm モジュール
UserForm ひとつと、CommandButton、TextBox それぞれ一つずつ。
MsgBox が出ないものは、ColorIndex がありません。

'-----------------------------------

Const sCOLORS As String = "0,FFFFFF,FF,FF00,FF0000,FFFF,FF00FF,FFFF00,80,8000," & _
"800000,8080,800080,808000,C0C0C0,808080,FF9999,663399,CCFFFF,FFFFCC," & _
"660066,8080FF,CC6600,FFCCCC,800000,FF00FF,FFFF,FFFF00,800080,80,808000," & _
"FF0000,FFCC00,FFFFCC,CCFFCC,99FFFF,FFCC99,CC99FF,FF99CC,99CCFF,FF6633," & _
"CCCC33,CC99,CCFF,99FF,66FF,996666,969696,663300,669933,3300,3333,3399," & _
"663399,993333,333333"

Private Sub CommandButton1_Click()
Dim arColor As Variant
Dim num As String
Dim ret As Variant
　　arColor = Split(sCOLORS, ",")
　　CommonDialog1.Color = TextBox1.BackColor
　　CommonDialog1.Flags = CommonDialog1.Flags Or MSComdlg.ColorConstants.cdlCCRGBInit

　　CommonDialog1.CancelError = True
　　On Error Resume Next

　　CommonDialog1.ShowColor
　　ret = Empty
　　num = Hex(CommonDialog1.Color)
　　ret = WorksheetFunction.Match(num, arColor, 0)
　　TextBox1.BackColor = CommonDialog1.Color
　　If Not IsEmpty(ret) Then
　　　　MsgBox ret
　　End If

　　On Error GoTo 0
End Sub

回答No.3

Wendy02

こんにちは。

>組み込みダイアログを使用して、色の選択が出来ないか？
それは、たぶん可能だとは思いますが、Excelの外の問題でしょうね。
Excel.Application側とダイアログの間で通信をしているはずですが、私には分かりません。

あまり難しく考えるよりも、UserFormで作ったほうが早いと思います。最初、簡単なマクロで作ってみましたが、質問者のためよりも、自分のアドインにするために、いろいろ付け加えてみました。

こういう内容が、サイトの趣旨に反するのか、私には分からないですが、何に使うかにもよります。どちらかというと、他人のためよりも、自分のために考えたほうがよいのかなって思いました。

左から、縦にColorIndex 順に、8個ずつ並ぶようにしてみました。しかし、Excelの組み込みのカラーパレットは、縦に5 × 8 の名前を付けた表と、2×8 の名前のない表のようですから、もう少し、マクロの工夫が必要かもしれません。

組み込みカラーパレットのColorIndexの並び

1　　53　　52　　51　　49　　11　　55　　56
9　　46　　12　　10　　14　　5　　47　　16
3　　45　　43　　50　　42　　41　　13　　48
7　　44　　6　　4　　8　　33　　54　　15
38　　40　　36　　35　　34　　37　　39　　2

17　　18　　19　　20　　21　　22　　23　　24
25　　26　　27　　28　　29　　30　　31　　32

ここら辺りは、各ユーザーの工夫にお任せすることにします。

ちょっと工夫すれば、このような並びも可能です。ラベルのインデックス自体は、別に組み込んでありますから、それを利用すれば可能です。ただし、それは、それは、ここの掲示板では公開しません。各ユーザーにお任せします。

ラベルに色が塗ってあって、それぞれに、イベントを付けてあります。
もともとは、全部のラベルにColorIndex が書いてあるのですが、濃い色の場合は、文字が見えませんので、左クリックすると、色番号のメッセージボックスが出てきます。右クリックすると、色の名前が出てきます。
名前の出てこないものもありますが、それらは、二段目のパレットにあるものです。

コントロールを何も付けない　UserForm を一つ用意してください。

UserFormモジュール,標準モジュール,Class モジュールの三つを使います。Class は、一応、カプセル化されています。UserForm を立ち上げれば、

UserForm1.Show 0

カラーパレットが出てきます。

ひとつだけ問題は、Excelの本体(Application)のパレットを変更しても、以下は、標準のColorIndex のままです。

'---------------------------------------------------

'UserForm モジュール
Dim myClass(56) As Class1
Const sCOLORS As String = "0,FFFFFF,FF,FF00,FF0000,FFFF,FF00FF,FFFF00,80,8000," & _
"800000,8080,800080,808000,C0C0C0,808080,FF9999,663399,CCFFFF,FFFFCC," & _
"660066,8080FF,CC6600,FFCCCC,800000,FF00FF,FFFF,FFFF00,800080,80,808000," & _
"FF0000,FFCC00,FFFFCC,CCFFCC,99FFFF,FFCC99,CC99FF,FF99CC,99CCFF,FF6633," & _
"CCCC33,CC99,CCFF,99FF,66FF,996666,969696,663300,669933,3300,3333,3399," & _
"663399,993333,333333"
Dim myLbl As Control

Private Sub UserForm_Initialize()
　　Dim i As Integer
　　Dim arColor As Variant
　　With Me
　　　.Height = 153
　　　.Width = 240
　　　.Caption = "ColorPalette"
　　End With
　　arColor = Split(sCOLORS, ",")
　　For i = 1 To 56
　　　　With Controls.Add("Forms.Label.1")
　　　　　.Left = 2 * (Int((i - 1) / 8) * 15)
　　　　　.Top = 2 + 15 * ((i - 1) Mod 8)
　　　　　.Width = 30
　　　　　.Height = 15
　　　　　.Caption = "[" & i & "]"
　　　　　.BackColor = CLng("&h" & arColor(i - 1))
　　　　End With
　　Next i

　　Call SetClass
End Sub
Private Sub SetClass()
　　　Dim myLabels As New Collection
　　　Dim i As Integer

　　　For i = 1 To 56
　　　　　 myLabels.Add Me.Controls("Label" & i)
　　　Next i
　　　For i = 1 To 56
　　　　　Set myClass(i) = New Class1
　　　　　With myClass(i)
　　　　　　.Lbl = myLabels(i)
　　　　　　.Index = i
　　　　　End With
　　　Next i

End Sub

'---------------------------------------------------
'標準モジュール
Public Const COLORNAMES As String = _
"黒,白,赤,明るい緑,青,黄,ピンク,水色," & _
"濃い赤,緑,濃い青,濃い黄,紫,25%灰,50%灰色," & _
"-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,スカイブルー," & _
"薄い水色,薄い緑,薄い黄,ペールブルー,ローズ,ラベンダー," & _
"ベージュ,薄い青,アクア,ライム,ゴールド,薄いオレンジ,オレンジ," & _
"ブルーグレー,40%灰色,濃い青緑,シーグリーン,濃い緑,オリーブ,茶,ライム,インディゴ,80%灰色"

'---------------------------------------------------
'Class1 モジュール

Private WithEvents myLabel As MSForms.Label
Private myIndex As Integer

Private Sub myLabel_Click()
　MsgBox myIndex
End Sub

Public Property Get Lbl() As MSForms.Label
　　　Set Lbl = myLabel
End Property
Public Property Let Lbl(ByVal lbNewValue As MSForms.Label)
　　　Set myLabel = lbNewValue
End Property

Public Property Get Index() As Integer
　　　Index = myIndex
End Property

Public Property Let Index(ByVal intNewValue As Integer)
　　　myIndex = intNewValue
End Property

Private Sub myLabel_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　Dim ColorName As Variant
　ColorName = Split(COLORNAMES, ",")
　If Button = 2 Then
　 MsgBox ColorName(myIndex - 1)
　End If
End Sub

'---------------------------------------------------
注：アップロードのために、定数(Const)の桁折「& _」をしていますが、本来は不要です。

回答No.2

lark_0925

本格的にやるなら、ＡＰＩですが、私も面倒なのでDialogsオブジェクトで
代用してしまいす。

'============================================================
Sub main()
　　Dim clx As Long
　　If get_color(Range("a1"), clx) Then

　　　MsgBox clx
　　　End If
End Sub
7===========================================================
Function get_color(rng As Range, clx As Long) As Boolean
　'input rng --ダミーのセル
　'oouput clx Colorindex
　Dim ans As Boolean
　rng.Parent.Parent.Activate
　rng.Parent.Activate
　rng.Select
　get_color = Application.Dialogs(xlDialogPatterns).Show
　If get_color = True Then
　　　clx = rng.Interior.ColorIndex
　　　rng.Interior.ColorIndex = xlNone
　　　End If
End Function

因みにＡＰＩでやる場合は、

http://www.loadsystem.net/api/lsapi3.txt

↑ここを参考にします。

Dialogsオブジェクトの使用では、

http://nyama.jpn.org/otto/xlstip.shtml#7
これも使いますね

回答No.1

nayuta_lot

こんにちは
フォームを使ってボタンを押すとダイアログがでるような事をしたい
のか、マクロの中で処理するのに使用したいのかよくわかりませんが、
取得・設定するなら、ColorIndexで取得・設定する方法とRGB指定で
取得・設定する方法があります。

(1)セル指定.Interior.ColorIndex = カラーNo.

※セル指定：Range,Cells,ActiveCellなど
　カラーNo.:1～56

(2)セル指定.Interior.Color = RGB(Red, Green, Blue)

※セル指定：Range,Cells,ActiveCellなど
　Red, Green, Blueは各0～255の値

使用例

　ActiveCell.Interior.ColorIndex = 5（青）‥
　アクティブセルのカラーパターンを青に設定

　Dim i As Integer
　i = ActiveCell.Interior.ColorIndex
　アクティブセルのカラーパターン値をiに取得‥青なら5が入る

　色見本のあるサイト↓
　http://www.relief.jp/itnote/archives/000482.php

　色見本を作るマクロを、ここに記載するのは簡単ですが本サイトの
　趣旨に反しますので、For Nextや、ActiveCell.Offset(行,列)など
　を使ってご自身で色見本をつくるようなマクロを作ってみてください。
　それだけでも勉強になると思いますので

　いきずまったら、またマクロを記載の上、質問してください＾＾
　では、健闘を祈りますｗ。