ドット絵への変換について

現在画像をExcel上でドット絵に変換しようと思っています。１枚や２枚なら手作業でもよかったのですが、２０枚程度あるのでさすがに手作業では不可能です。
そこで、できれば画像の入ったフォルダを選択し、その中の画像を（BMP）順番にドット絵に変換していくようなマクロを組みたいです。（そして１シートにつき１枚ずつドット絵を配置したいです。）
今のところ画像を選択してドット絵に変換するマクロは組めたのですが、それをどうすれば「新しくシートを作成し、画像をドット絵に変換していく」作業を繰り返せるのかがわかりません。
どなたかご存知でしょうか。
（フォルダの中のファイルを順番に選択して新しいシートで処理していくにはどうすればよいでしょうか？vbaで順番に選択して処理をする方法が分かりません。）

No.1 回答者： stomachman 回答日時： 2020/09/15 22:36

とりあえずシートを作っては静止画を貼る、ということだけできれば、手直しするのは簡単でしょう。

その方法は、マクロを自動記録させて、手作業で「1枚シートを追加し、写真（ファイルからの画像）を選んで挿入する」ってことをやってみれば、大体お分かりになるでしょう。例として、静止画をmov 01.png 〜 mov 10.pngとします。

Sub Macro1()
firstFileName$ = Application.GetOpenFilename() ' dialogで、画像を一つ選択する。
leader$ = Left(firstFileName$, Len(firstFileName$) - 6) ' "xx.png"の部分を取り除く。ファイルの番号が2桁だから6文字捨てる。(フォルダの場所が決まっているのなら、最初からleader$に明示的にパスを書き込んでおけば良いのだが）
For i = 1 To 10
target$ = leader$ & Format(i, "00") & ".png" ' 番号2桁を付け加えて、パスの文字列を完成させる。
Sheets(1).Pictures.Insert(target$) 'ドット絵に変換する代わりに画像を貼るだけ。
Sheets.Add
Next i
End Sub

しっかし「画像を選択してドット絵に変換するマクロ」って、すげえな〜。教えてくださいよ。

この回答へのお礼

試しに実行してみたのですが「実行時エラー1004　PicturesクラスのInsertメソッドが失敗しました」と表示されて失敗します。
あと、ソースコードを載せようとしたのですが文字数制限のため書き込めませんでした。
なので参考にさせていただいたサイトを紹介します。
「https://gist.github.com/tsunakan/6dda1933e2c3a1a …」一部変更して使用しています。（BMPのみ可です）
それと、長くなってしまい申し訳ありませんが、フォルダの中の画像を順番に処理していく（n番目を選択する）のにはどうすればよいのでしょうか？
同じ処理をループさせるのは理解したのですが順番に処理をする方法が良くわかりません。

〈イメージ〉
フォルダを選択↓
中の画像を読み込む↓
新しいシートを作成し、n番目のシートにn番目の画像をドット絵化↓
それを繰り返す

お礼日時：2020/09/16 19:00

No.2 回答者： stomachman 回答日時： 2020/09/16 21:31

No.1へのコメントについてです。

Sheets(1).Pictures.Insert(target$)
が失敗する？
（Insert（画像を貼る）のが目的ではなくて、そのファイルの画像をドット絵に変換するんですから、Insertが失敗したって全然構わんわけですが、しかし、）失敗するということは、まず疑われるのが、target$に正しいパスが入ってない、ということでしょうね。画像ファイルのタイプは".png"ですかね？例えば".jpg"だったりするのなら、".png"を全部".jpg"に書き換えなくちゃ。
　…とか、細かいことを考える前にまずは、マクロを自動記録する状態にして（ツールmenu→マクロ→新しいマクロの記録…とかにある)、手作業で画像を貼り付けてみて、その結果一体どんなマクロが記録されるかを観察なさるのが良いでしょう。

> 順番に処理をする

それにはNo.1のマクロが for ループを使って

for i=1 to 10
　　target$ = i番目の画像ファイルのパス
　　ファイルtarget$の画像をシートに貼る。
　　シートを追加する。
next i

という処理をやってるんですから、これを

for i=1 to 10
　　target$ = i番目の画像ファイルのパス
　　ファイルtarget$の画像をシート上のドット絵に変換する。
　　シートを追加する。
next i

に書き換えればいいんです。

この回答へのお礼

すみません、そういえばドット絵にするためにBMPになっていました。jpgで試したらちゃんと実行できました。
順番に処理するのは、マクロの記録をもとにもう少し考えてみます。助言ありがとうございます。

お礼日時：2020/09/16 22:00

No.3 回答者： fujillin 回答日時： 2020/09/18 15:02

こんにちは

横からですが・・・

ご参考になさっているVBでは
　・「画像ファイルを選択」し
　・その画像をActiveSheetへドッド絵で貼付ける
ようになっていますので、「画像ファイルを選択」の部分を省略して、直接、画像ファイルのパスを渡して呼出すようにすれば良いでしょう。


以下は、「フォルダを選択」したら、そのフォルダ内（フォルダ直下のみ）の、bmp画像ファイルを順に検索して行くものです。
（サンプルでは、ひとまずActiveSheetのA列にファイル名を追加するようにしてあります。）

実際には、得られた画像ファイルパスを、そのままご参考のルーチンに渡して処理させるようにすれば良いでしょう。（新しいシートを作成しておくのもお忘れなく。）

Sub Sample()
Dim folder As String, file As String

'フォルダ選択ダイアログ表示
With Application.FileDialog(msoFileDialogFolderPicker)
　If .Show = False Then Exit Sub
　folder = .SelectedItems(1)
End With

'検索ファイルをフォルダ下のBMPのみに制限
file = Dir(folder & "\*.bmp")

While file <> ""
'　次の一行で該当ファイル名をシートに書き出しているので、
'　書き出す代わりに、そのファイルを開くようにすれば良い
'　もしも新しいシートを作成したいのなら、以下の1行を追加
'　　　Worksheets.Add
'　シートが作成され、そのシートがActiveになる
'
　Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = folder & "\" & file
　file = Dir()
Wend
End Sub


しかしながら・・・
＞２０枚程度あるのでさすがに手作業では不可能です。
20枚程度なら、順に処理してもたいしたことないと思いますけれど？？
（人間が行うのは、ファイルの選択行為だけなので、それを20回やればいいだけ）