エクセルでドット絵、右クリックで色取得、左クリックで色塗りマクロ

セルに色を塗る時パレットから色を選んだら左クリックだけで色を塗りたい

お絵かきアプリのように

 

http://www.geocities.jp/gogowaten/excel_animation01.gif

CheckBox1にチェックを入れて色塗り開始

右クリックで色を選んで左クリックで色を塗る

 

 

必要なのはActiveXコントロールのImage1とCheckBox1

 

開発タブの挿入からActiveXコントロールのイメージ(Image)と

 

チェックボックス(CheckBox)を挿入

 

マクロを書く場所はシートモジュール

Visual Basic エディタを開くにはAlt＋F11か

開発タブの右端のVisual Basicを押す

プロジェクトの一覧からチェックボックスとかを挿入したシートを探す

ブック名とシート名を確認

今回はブック名がBook2でシート名がSheet1なので

VBAProject(Book2)の中にあるSheet1(Sheet1)を右クリックして

メニューからコードの表示を選択

以下をコピペ

 

Dim x, y As Long
Dim myColor As Long
Dim isBlank As Boolean '透明フラグ
Dim oldBlank As Boolean '透明フラグ、元のセル用


'右クリック出色の取得
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If CheckBox1.Value = False Or x = 0 Then Exit Sub
    If oldBlank Then
        Image1.BackColor = RGB(255, 255, 255)
        Target.Interior.Pattern = xlNone
    Else
        Image1.BackColor = myColor 'Image1のバックカラーを取得しておいた色に変更
        Target.Interior.Color = Image1.BackColor '右クリックしたセルをImage1のバックカラーで塗る
    End If
    
    '透明判定してフラグ設定
    If Target.Interior.Pattern = xlNone Then
        isBlank = True
    Else
        isBlank = False
    End If
    
    Cancel = True '右クリックメニューを表示しない
End Sub

'選択範囲変更で色塗り
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CheckBox1.Value = False Then Exit Sub
    Dim myCells As Range
    x = Target.Row
    y = Target.Column
    
    '透明判定してフラグ設定
    If Cells(x, y).Interior.Pattern = xlNone Then
        oldBlank = True '透明だった場合
    Else
        oldBlank = False '透明じゃなかった(色付きの)場合
        myColor = Cells(x, y).Interior.Color '元の色を取得
    End If
    
    '選択セル範囲の色をImage1のバックカラーで塗る
    For Each myCells In Target
        If isBlank Then '透明判定
            myCells.Interior.Pattern = xlNone '透明で塗る(塗りつぶしなし)
        Else
            myCells.Interior.Color = Image1.BackColor '色塗り
        End If
    Next
End Sub

 

 

 

 

コピペしたところ

これで完成

 

 

使う色を適当なセルに塗っておいて

午後のパレットを使って色を塗っているところ

 

チェックを入れる前に色の付いていないセルを選択しておく

 

チェックを入れる

 

色の選択は右クリック

右クリックするとImage1に今の色が表示される

 

色塗りはクリック(左クリック)

クリックしたセルに今の色が塗られる

 

ドラッグで範囲内も塗れるし

キーボードの矢印キーでも塗れる

色を消したい時は

色のないセルを右クリックしてから

色を消したいセルを左クリック

 

 

仕様1

塗られる色はRGBで指定して塗っているので

ブックのテーマを変更しても色は変化しない

 

仕様2

もう一つが色を塗った後に同じセルを右クリックすると色が変わってしまう

普通に使っていれば行わない操作だし致命的ではないから多少はね？

 

ダウンロード

ファイル名

エクセルでドット絵、右クリックで色取得、左クリックで色塗りマクロ.xlsm

OneDrive エクセルでドット絵、右クリックで色取得、左クリックで色塗りマクロ.xlsm

エクセル2007 - OneDrive

ヤフーボックス 

 

 

 

 

この機能をアドインの午後のパレットに取り込めたらいいんだけど

どうすればいいのか皆目見当がつかない

ワークシートモジュールじゃなくても

Worksheet_SelectionChangeのような動作ってできるのかなあ

ユーザーフォームのパレットから選んだ色を左クリックしたセルに塗る動作

こう書くと簡単そうなんだよなあ

→できた

gogowaten.hatenablog.com

 

 

塗りつぶしなしの処理を省くと、こんなに短くなる

Dim x, y As Long
Dim myColor As Long

'右クリック出色の取得
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If CheckBox1.Value = False Then Exit Sub
    Image1.BackColor = myColor 'Image1のバックカラーを取得しておいた色に変更
    Target.Interior.Color = Image1.BackColor '右クリックしたセルをImage1のバックカラーで塗る
    Cancel = True '右クリックメニューを表示しない
End Sub

'選択範囲変更で色塗り
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CheckBox1.Value = False Then Exit Sub
    Dim myCells As Range
    x = Target.Row
    y = Target.Column
    myColor = Cells(x, y).Interior.Color '元の色を取得
    For Each myCells In Target '選択セル範囲の色をImage1のバックカラーで塗る
        myCells.Interior.Color = Image1.BackColor
    Next
End Sub

 

 

最初はこうだったけどやっぱり塗りつぶしなしもあったほうが便利だと思って

書いていたら2倍以上になってしまった

 

関連リンク

gogowaten.hatenablog.com