こんにちは、デスクワークラボの吉井良平です。
工務店さんから、「工事報告書をもっと楽に作りたい」という依頼があって、
せっかくのご依頼なので対応してみようと、慣れないCADなどもつつきながらあれこれやっています。
その中で、「工事中の写真を一覧にして印刷する」という工程があって、
「まぁ何かソフトがありそうだとは思いつつ、自分で作れるものは作ってみよう」ということで、写真を一覧にしてエクセルに貼り付けるプログラムを作りました。
いざ作ってみると、これはいろいろ応用範囲が広そうなので、ブログの記事にしてみますね。
手作業で一つ一つ画像を貼り付けていらっしゃる方がいれば、
こういった作業はパソコンにまかせた方が早いし、正確だし、自分自身の精神的にも楽です。
ご参考にしていただければ幸いです。
デジカメで撮った写真を一覧で貼り付ける作業
考えてみると、デジカメで撮った写真を一覧にして印刷、報告する機会は結構多いように思います。
工事現場の場合は、工事をした経過の証拠として、写真の提出が求められますよね。
自作で簡単にカタログやメニューを作ろう、とした場合にも、写真の一覧が必要です。
会社で何かイベントをした場合、デジカメの写真を一覧にして上司に提出しておくと、上司もその場の雰囲気が分かって良いです。（フォルダに入っている画像を見てください、で済む場合は良いですが）
特に報告をする必要が無くても、これまでに行った対応実積を写真に撮っておいて、後でコメントをつけて保存しておくと、立派な顧客対応履歴になります。ネイリストさんが過去の施術履歴を整理したり、ハンドメイドの雑貨の製作実積を整理したり、いろんなことに使えそうです。
これまで面倒でやってなかったことも、「一気に一覧で挿入できるんならやってみようかな」と思う方もいらっしゃるのではないでしょうか？
動画を撮ってみました
「写真を一覧で、一発で貼り付けする」というと分かりにくいかもしれませんので、実際にどんなものか動画を撮ってみました。
画像のサイズが大きいと少し読み込みに時間がかかりますが、それでも手作業でやるよりは断然早いと思います。
なお、画像のサイズ調整、貼り付け位置は、ご自分である程度は調整できます。
画像を一覧で貼り付けるプログラムの紹介
では実際に、画像を一覧で貼り付ける方法を紹介していきますね。
画像を一覧で貼り付けるには、エクセルの「マクロ」という機能を使います。
画像のファイル名一覧を取得する部分
プログラムが長くなるので、全体を二つの部分に分けました。
まずは挿入する画像のファイル名を、フォルダー単位で取得する部分です。
Sub 画像一覧取得()
Dim myFile As Variant
'ファイルを開く形式で、フォルダーを指定する
myFile = Application.GetOpenFilename("jpgファイル(*.jpg),*.jpg")
Dim vFileName As String
Dim Num As Long
'取得したパス名を記録しておく
Cells(5, 2) = myFile
Dim PathLength As Integer
PathLength = Len(myFile)
Dim N1 As Long
N1 = 1
'ファイル名以外の部分を残すために最後の\の位置を確認する
Do
Cells(6, 2) = Right(myFile, N1)
N1 = N1 + 1
If Left(Cells(6, 2), 1) = "\" Then
Exit Do
End If
Loop
Cells(7, 2) = Left(myFile, Len(myFile) + 1 - Len(Cells(6, 2)))
vFileName = Dir(Cells(7, 2))
Columns(9).Delete
Num = 3
'パスの中にあるファイル名をすべて書き出す
Do Until vFileName = ""
Cells(Num, 9) = vFileName
Num = Num + 1
vFileName = Dir
Loop
End Sub
少し解説
画像ファイルの一覧を取得するためには、まずは画像が保存されているフォルダーのパス（フォルダーの位置）を指定する必要があります。
パスを手入力で指定するのは面倒なので、「Application.GetOpenFilename(“jpgファイル(*.jpg),*.jpg”)」（6行目）で、普通にファイルを開く作業でフォルダーのパスを取得するようにしています。
ここだけがちょっと工夫した部分なので、一応解説しておきます。
あとは、この部分ではあまり変更することは無いと思いますので、これ以上の説明は割愛しますね。
なお、ファイル名を書き出さなくても画像の一覧を挿入することはできますが、初心者にイメージしやすかったり、他にも何か応用を思いつくかもしれませんので、わざと一覧を書き出すようにしています。
画像を挿入していく部分
次は、実際に画像を貼り付け（挿入）していく部分です。
この部分は、実際の帳票（1ページに何枚掲載するのか）に合わせて、自分の手で変更していく必要があります。
Sub 写真を挿入する()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("手順")
'一覧貼り付け用シートをコピーして使う
Worksheets("写真一覧用").Copy after:=WS1
ActiveSheet.Name = Format(Date, "YYMMDD") & Second(Now)
Set WS2 = ActiveSheet
Dim LCRN1 As Long
LCRN1 = WS1.Cells(3, 9).End(xlDown).Row
Dim PicName As String
Dim PicID As String
Dim N1 As Integer
Dim Zahyou As Long
Dim StrNum As Long
Cells(1, 2).Select
StrNum = 3
Zahyou = 96
'一つ一つの画像を貼り付けて移動させる
For N1 = 3 To LCRN1
PicName = WS1.Cells(7, 2) & WS1.Cells(N1, 9)
PicID = WS1.Cells(N1, 9)
ActiveSheet.Pictures.Insert(PicName).Select
With Selection
.Top = Zahyou
.Left = 50
.Width = 364
.Height = 242
End With
Cells(StrNum, 1) = PicID
StrNum = StrNum + 16
Zahyou = Zahyou + 384
Next
End Sub
プログラムを使う前の準備
写真を貼り付けしていく際には、「どの間隔で次の画像を貼り付けるのか」をプログラムで指定してやる必要があります。
なので、写真貼り付け用に、あらかじめセルの高さを実際に使う高さに調整しておいたシートを作っておきましょう。
今回は、セルの高さを24に設定したシートを作っています。
また、セルの高さを設定したシートは、分かりやすいように名前を付けておきましょう。
今回のプログラム用がそのまま使えるテンプレートを用意していますので、プログラムをテストされる場合はダウンロードしてみてください。
プログラムの中で変更する部分
実際に画像を挿入する際は、画像のサイズや間隔を調整していきますよね。
画像のサイズを調整する場合は、39行目と40行目の
.Width = 364
.Height = 242
の右側の数値を、適当な大きさに変更してください。（Widthが幅で、Heightが高さです。なお、Leftは左端からの位置です。）
一番上の画像を貼り付ける位置をしているのは、24行目の
Zahyou = 96
の部分です。セルの高さを24にしているので、24ｘ4 = 96 （4行目の高さ）から画像を挿入するように、このプログラムではなっています。
ファイル名と画像を貼り付ける間隔は、46、47行目で指定しています。
StrNum = StrNum + 16
Zahyou = Zahyou + 384
StrNum（ファイル名を入れる行）を16行ごとの間隔にしているので、
Zahyou（画像を貼り付ける位置）は、16ｘ24 = 384 の間隔ということになります。
ご自分の貼り付けしたい間隔に合わせて、この部分の数字を変更していってください。
セルの行番号で挿入位置を指定する方法
2022年7月追記：セルの行番号で貼り付けたい、という依頼が実際には多かったので、セルの位置を取得して貼り付ける場合は、ActiveSheet.Pictures.Insert(PicName).Selectで画像を挿入した後の部分を、
With Selection .Top = Cells(N1 * 5, 2).Top .Left = Cells(N1 * 5, 2).Left .Height = 100 End With
としてみてください。
※今回は、5行間隔で位置を指定することにしたので、繰り返し変数N1に対して5を掛けています。画像の高さ(Height）、幅(Width）は、大体ちょうど良い大きさにしてくださいね。
まとめ
以上、画像をエクセルに一覧で貼り付ける方法を紹介しました。
初めての方には、ややこしいとは思いますが、参考にしてみてください。
