午後ツール(午後のパレット)その49、エクセルのカラーピッカー(アドイン)午後は何色を作ってみた

gogowaten.hatenablog.com

の続き

エクセルアドイン、午後ツール(午後のパレット)更新

2016/12/20

右クリックメニューにウィンドウ切り替えボタンがあるときはシート一覧をその下に追加するようにした
アドイン、カラーピッカーの午後は何色を追加

右クリックメニューへシート一覧の追加場所変更

この状態から今表示しているブック(午後のパレット_20161220)の

シート一覧を追加してみる

これをクリックして確認してみる

以前は一番上に追加していたけどウィンドウ切り替えボタンがあるときは

その下に追加するようにした

午後は何色

選択した物の塗りつぶしの色(Fill)と文字色(Font)、枠色(Border)を表示する

対象にできるものは

Range、セル
Shape、図形
ShapeRange、図形
ChartArea、グラフ全体
PlotArea、グラフ内部
Series、グラフデータ系列(グラフ線とかの要素)
Axis、グラフ軸
Legend、グラフ凡例

色の表示形式は

RGB(255, 255 ,255)
HSL(360, 255, 255)
Long(10進数)
#(HEX、16進数)
NTSC(輝度)
HDTV(輝度、ガンマ値2.2)

f:id:gogowaten:20191030141232p:plain

起動するアイコンの場所はここ

よく使うものの色はだいたい取得できるけど

スタイルのテーブルとして書式設定したセルの色は…

取得できない

テーブルの書式は特別みたいねえ

他にも取得できない時があると思う

それでも…

コピペすれば取得できる

ダウンロード先(ヤフーボックス)

ファイル名：午後のパレット_20161220.xlam
https://box.yahoo.co.jp/guest/viewer?sid=box-l-3rjuj7hqmqr7b3al3lvxcim3ku-1001&uniqid=1efa05ac-f4ab-4b39-a885-7629dd8c9297&viewtype=detail

同じ塗りつぶしでも対象物が変わると色のある場所が変わる

セルの塗りつぶしはInterior.Color

図形やグラフ全体はFill.Forecolor

グラフの軸や要素はFormat.Forecolor

ああでもInteriorはセルだけっぽいから、セル以外はFill.ForecolorかFormat.Forecolorのどちらかってことでいいのかなあ

あとはグラデーションの場合だとまた違った場所に変わったりだとか

エクセル2007ではグラデーションの枠の色は取得できなさそうだとか

エクセル2007は図形やグラフのマクロは記録できないから全部手作業とかで

見た目や機能が単純な割にはかなり手間がかかった

グラフの色取得は難しい

グラフの種類を変えただけで同じ要素でも塗りつぶしが枠になったり

2Dグラフで背景だったのが3Dグラフだと壁や床に変わったり

色指定が自動の場合にどこにその色があるのかわからなかったり

なのでグラフの色が自動だった場合は真っ黒や真っ白になって間違っているところもある

選択されているものの取得はとりあえず型指定した変数に入れてみて

入らなかったらそれは違う型だったんだなって言う無理矢理な方法を使っている

↓

On Error Resume Next
Dim r As Range: Set r = Selection 'セル
Dim sr As ShapeRange: Set sr = Selection.ShapeRange '図形の場合
Dim ca As ChartArea: Set ca = Selection 'ChartAreaグラフ全体
Dim pa As PlotArea: Set pa = Selection 'PlotArea、グラフ内部
Dim ser As Series: Set ser = Selection 'Series、データ系列(グラフ線とかの要素)
Dim ax As Axis: Set ax = Selection 'Axis、軸
'  Dim gl As Gridlines: Set gl = Selection 'Gridlines、目盛線
Dim leg As Legend: Set leg = Selection 'Legend、凡例
Dim s As Shape: Set s = Selection 'Shape、図形

Select Case True
    Case Not r Is Nothing
   'セルの場合
        Me.LabelType表示用.Caption = TypeName(r)
        GetSelectionColorSet = GetCellColor(r.Cells(1))
    Case Not sr Is Nothing
   '図形
        Me.LabelType表示用.Caption = TypeName(sr)
        GetSelectionColorSet = GetShapeRangeColor(sr)
    Case Not ca Is Nothing
    Case Not pa Is Nothing
    Case Not ser Is Nothing
    Case Not ax Is Nothing
'      Case Not gl Is Nothing
    Case Not leg Is Nothing
    Case Not s Is Nothing
    Case Else
        Me.LabelType表示用.Caption = "n/a"
End Select

On Error GoTo 0