Excelで画像をドット絵にしてみる
作ってみる
こんな感じにして、矢印の右下をクリックした時にそこから右下の範囲を1ピクセルずつ、色を取得して別シートに転記するようにしてみました。
コード
Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long Private Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As LongPtr Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr #Else Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long #End If Private Type POINT x As Long y As Long End Type Sub drawPic() Dim pLocation As POINT Dim lColour As Long Dim i As Long, j As Long Dim lDC As Variant Dim tate As Long, yoko As Long Dim tateGeta As Long, yokoGeta As Long Application.ScreenUpdating = False tate = Range("B1") yoko = Range("B2") lDC = GetWindowDC(0) Call GetCursorPos(pLocation) tateGeta = pLocation.y yokoGeta = pLocation.x With Sheets("ドット絵") .Cells.Clear For i = 1 To tate For j = 1 To yoko lColour = GetPixel(lDC, j + yokoGeta, i + tateGeta) .Cells(i, j).Interior.Color = lColour Next Next End With Application.ScreenUpdating = True End Sub
こんな感じです。
課題
- 遅い
- 画像の範囲をぴったり指定できない
どっちも、わりと痛いです。
*1:謎のキャラクターは、Life Is Strange のある場所の落書きからご登場いただきました
VBAは初心者におすすめのプログラミング言語なのか
こちらの記事に、初心者におすすめのプログラミング言語10選として、我らがVBAが仲間入りしていました。
錚々たるメンバーの中にラインナップされたのは喜ばしいことだと思います。*1
VBAのメリットとして
- 実務で使える
- 環境構築が簡単
- 情報の充実
あたりが挙げられていて、そのとおりだと思いますが、他の言語と比べた時に自分がいいところだと思うのは
作ったものがすぐに見える
というところです。
Web系の言語の勉強をしていた時*2に、DBとのデータやりとり、データの処理とは別に「表示させる部品を作る」ということで苦労した思い出があります。
そして、初心者だから、表示できなくてもどこが悪いのかわからない。*3
それに比べると「ここのセルの値をこれにする」とか、「ここの範囲をこの色に塗る」とか、「シート」や「セル」という馴染みのある部品を操作することができるのはかなりお得な感じです。
で、VBAがプログラミング初心者におすすめといえるかというと、まあ、人によるかなと。
VBAのレッスンをしている自分からすればもちろん、「え? プログラミングをやってみたい? VBAおすすめですよげっへっへ」と言いたいところなんですが、正直、Web系とかゲーム系をやりたいなら最初からそっちをやったほうがいいと思います。
VBAを先にやるメリットというのは特に思いつきません。
自分の感覚としてはあくまでも
「事務系の仕事でExcelを使ってるんだけど、同じ処理ばっかりでうんざりする。
VBAとかいうのがあるって聞いたけどそれを使えば楽にできるの?
あーでもプログラミングなんでしょ難しいんでしょ」
という人におすすめ、という感じです。*4
基本的にプログラミングの勉強というのは目的がないと続かないので、ExcelVBAは「Excelのこのめんどくさいこの作業を楽にしたい」という崇高な目的がある人にはとてもおすすめです。
*1:個人的にはHTMLとCSSはJavaScriptに編入されてもいいかなと思いますが
*2:そんなにしてないけど
*3:だからこそ、単純に「Hello World!」が表示されるだけでも嬉しいわけですが
*4:そんな人は是非ご連絡ください
Excelでドット絵作成ツールを作る v1.0.0 配布の巻
- ツールの説明
- 動作環境
- 操作方法
- 通常モード
- 元に戻す&やりなおす
- 手動モード
- 通常モード
- 設定
- 描画色、置換色
- キャンバスのサイズ
- 画像ファイル種別
- ファイルのダウンロード
- はじめの準備
- 編集を有効にする
- コンテンツの有効化
- 諸注意とか
- 参考ページ
- 質問、ご意見等
- コード
動作環境
Excel2016 で動作確認済です。
Excel2007以降であれば大丈夫なのではと思いますが、動作報告いただければ助かります。
操作方法
モード切替で、モードが切り替わります
通常モード
キャンバス内のセルをクリックやドラッグで選択すると、「描画色」に塗ることができます
元に戻す&やりなおす
通常モードでの描画操作は、それぞれのボタンで「元に戻す」「やりなおす」ことができます
(描画の履歴を残して再現しているだけなので、標準のものとは動きが異なります)
手動モード
選択しただけで色が変わったりしないので、標準のコピーやペースト機能が使えます
設定
キャンバスのサイズ
たて、よこのサイズを個別に指定できます。
あまり大きいと重くなるのと、操作画面が見にくくなるので、とりあえずたて、よこ共に上限を100としています。
(下にも記載しましたが、VBAの改変は自由なので、解除可能です)
はじめの準備
ファイルを開いたときになんだかメッセージが出てきたら、以下を実行してください
編集を有効にする
保護ビューで開いた場合、「編集を有効にする」をクリック
コンテンツの有効化
セキュリティの警告が出たら、「コンテンツの有効化」をクリック
諸注意とか
- ファイルの改変、再配布は自由です(特に断りもいりません)
- ファイルをダウンロード、開いたことによるいかなる損害も当サイトは責任は負えません
参考ページ
パレットウィンドウ(カラーピッカー)の実装に関して、下記のページを参考にさせていただきました。
(ほとんどそのままです)
Excel VBA 背景色をパレットウィンドウから指定する PCまなぶ
質問、ご意見等
コメントに残していただくか、ホームページの問い合わせからお願いします。
Excelでドット絵作成ツールを作る その10
現状報告
こんな感じです。
「ブック出力」ボタンでファイル選択画面が開き、
選択したブックには、描画部分のみコピーされて保存されます。
コード
現時点でのコードは
'///標準モジュール/// <<画像出力>> Option Explicit Private Ext As String '拡張子 Dim SavePath As String 'ファイル保存ダイアログ Function getSavePath() As String Dim fPath As String Dim strExt As String strExt = Ext & "ファイル, *." & LCase(Ext) & ", 全てのファイル,*.*" fPath = Application.GetSaveAsFilename(fileFilter:=strExt) If fPath = "False" Then getSavePath = "" Else getSavePath = fPath End If End Function '画像出力 Sub imgOut() Dim rg As Range Dim cht As Chart Ext = Range("A23") '保存ファイル名を取得 SavePath = getSavePath If SavePath <> "" Then Call setSettings '設定を共通変数にセット Set rg = Range(BaseRng.Offset(1, 1), Cells(BaseRng.Row + Tate, _ BaseRng.Column + Yoko)) Application.ScreenUpdating = False rg.CopyPicture appearance:=xlScreen, Format:=xlPicture 'チャートを追加して画像貼り付け Set cht = ActiveSheet.ChartObjects.Add(0, 0, rg.Width, rg.Height).Chart cht.Parent.Select cht.Paste cht.Export FileName:=SavePath, filtername:=Ext cht.Parent.Delete Application.ScreenUpdating = True End If End Sub 'ブックに出力 Sub outToNewBook() Dim ws As Worksheet, cpWs As Worksheet Dim wb As Workbook Dim rg As Range Ext = "xlsx" '保存ファイル名を取得 SavePath = getSavePath If SavePath <> "" Then Set cpWs = Sheets("ドット絵") Application.ScreenUpdating = False Application.DisplayAlerts = False cpWs.Cells.Clear Call setSettings '設定を共通変数にセット Set rg = Range(BaseRng.Offset(1, 1), Cells(BaseRng.Row + Tate, _ BaseRng.Column + Yoko)) rg.Copy Destination:=cpWs.Range("A1") Set wb = Workbooks.Add cpWs.Copy before:=wb.Worksheets(1) For Each ws In wb.Worksheets If ws.Name <> cpWs.Name Then ws.Delete End If Next On Error GoTo err wb.SaveAs FileName:=SavePath On Error GoTo 0 wb.Close Application.DisplayAlerts = True Application.ScreenUpdating = True End If Exit Sub err: wb.Close MsgBox "出力できません" End End Sub
こんな感じです。*1
新規ブックに出力
新規ブックに出力する部分は、すでに出来ている画像出力と、以前書いた
vba-belle-equipe.hatenablog.com
こちらの記事を参考にしました。
(書き方忘れてました)
*1:変更のあったところだけです
思いつき連載 VBA王子 ニューヨークへ行く #11
前回
#11
「え? VBAの勉強? そりゃ、しなさいよ。しないとできないんでしょ? じゃ、しなさいよ。え? 通常業務は、やりながらに決まってるでしょ。え? 時間? 時間は作るんだよ。残業? 残業はつけちゃダメだよ。自主的に残るのは構わないけどさ。え? どういう意味かって? そりゃ、そういう意味だよ」
係長への相談終了後、赤羽は自席に戻って息をついた。飽きることもなく右手の爪を見ていた浮間が、すっと寄ってくる。
「いやあ、感心感心。赤羽君は、サービスいいね」
「しませんよ。サービス残業なんて」
「だよね。私も絶対やんない」
あなたは普通の残業もしないんです、と言うかわりに赤羽はうなずいた。
「でも、あんなにすぐになおせたんだから、キミにとってはお茶の子さいさいでしょ」
北浦から受け取ったファイルは赤羽が試し、浮間の手に渡っていた。うまく動いたようだ。
ということは北浦の言う通り、浮間がどこかいじった結果、うまく動かなくなっていただけ、ということだろう。
「さっきも言いましたけど、あれは、北浦さんがなおしてくれたんです。自分はまだ『こんにちは』って表示させることしか・・・」
「北浦って誰だっけ? ああ、あのおかっぱか」
「はい」
「てゆうか、お茶の子ってなんだろね」
「・・・なんでしょうね」
お茶の子について考えながら赤羽が地下に下りると、資料管理室は低いうなり声を発していた。
「・・・失礼します」
ドアを開けると、北浦はおかっぱ頭をきれいになびかせながら、陰気な目を向けてくる。赤羽は異常に気づかないふりをすることにした。
「浮間さんの件、大丈夫でした」
「・・・まあ、そうだろうな、あの女の場合。てゆうかこっちは大丈夫じゃなかったよ」
「何かありましたか」
「何かありましたよ。言ったよな? 蕨だけは来させるなって」
ああ、と赤羽は言った。
でも自分のせいじゃないんです。川口さんと話していたら蕨係長に聞かれていて、じゃあ私が行くってことになったので、それを止めるのは無理です。
とは言わず、胸の中に留めておいた。
「ああ、じゃないんだよ。おかげでこっちは滅茶苦茶仕事増えたんだぞ」
「大変ですね」
北浦は舌打ちした。
「大変ですね、じゃないよ。お前にもやってもらうぞ」
「え、無理ですよ」
「当たり前だ。だから、早く使い物になれ」
「ええと、なりたいのは・・・」
「やまやまです」
「え?」
「なりたいのはやまやまです、で終わりだ。『が』とか、いらん」
やまやまってなんだろう。
自分はやまやまになりたかったのだろうか。
赤羽は自分の胸に聞いてみようとしたが、すぐに意識を戻される。
「それから?」
「え?」
「お前んとこの係長に相談するって言ってただろ。1日あたり24時間までならVBAの勉強をしてていいって承認してもらったか?」
いえ、と赤羽はやりとりを説明した。
ふん、と北浦は鼻を鳴らした。
「まあ、どうせそんなとこだろう。通常業務は一切変わらないということなら、話は簡単だ」
「簡単ですか」
「通常業務を一瞬で終わらせろ。そうしたら、空いた時間にVBAの訓練ができる」
「そんな」
「無茶なってか? お前は何を見てたんだ。別のExcelファイルにシートをコピーして名前を変えるまで、一瞬で終わっただろ?」
「あ、そうですね」
「お前の業務で、マクロ化できる部分があれば、それだけ時間を短縮できるってことだ。だからとりあえず、洗い出しをするぞ」
「え、ひょっとして、マクロを作っていただけるんですか?」
「これは貸しだ」北浦は薄く笑った。「そのうち返してもらう」
「・・・なるほど」
そのうちが来る前になんとかしよう、と赤羽は心に決めた。
- つづく -