皆さんは大量の画像をExcelに貼り付ける場合どのようしていますか？
例えば下の様式に写真を貼り付けていく作業があるとします。
Excelに内蔵されているプログラミング言語を使えば、このような作業を一瞬で終わらせることができます。
本記事では、プログラムをコピペするだけで動作確認ができるように心がけています。
ですからプログラムなんて分からないという方でもご安心下さい。
ではさっそくやってみましょう。
手順① プログラムを貼り付ける画面を表示
まずはこちらの記事の手順を実行して、プログラムを貼り付ける画面を表示します。
【ExcelVBA】プログラミングする方法
Excelには業務効率化のための強力プログラミング言語が搭載されています。この記事ではそのプログラミング言語を使用するための方法を分かりやすく丁寧にご紹介します。
jitantech.com
2024.08.04
手順② プログラムのコピー
次にこのプログラムをコピーします。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
Sub pasteImage() ' 貼り付ける画像が格納されているフォルダを選択します With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then ' 取得したフォルダパスを変数に入れる folderPath = .SelectedItems(1) End If End With ' フォルダ内の画像パスを格納する配列を用意します Dim imagePath() As Variant ReDim imagePath(0) ' 1枚目の画像パスを配列に入れます imagePath(0) = Dir(folderPath & "\") ' 配列の画像パスのインデックス idx = 0 ' フォルダ内の画像の枚数分繰り返す Do While imagePath(idx) <> "" ' 配列に画像のパスを格納する idx = idx + 1 ' 配列を再定義します ReDim Preserve imagePath(idx) ' 配列に画像のパスを格納します imagePath(idx) = Dir() Loop ' 貼り付ける画像のインデックス pIdx = 0 ' シートの繰り返し For Each sh In ThisWorkbook.Worksheets ' 画像を４枚貼り付けます For i = 1 To 4 ' 貼り付け先のセルを指定します Select Case i Case 1 targetRange = "B2:D2" Case 2 targetRange = "I2:K2" Case 3 targetRange = "B12:D12" Case 4 targetRange = "I12:K12" End Select ' 画像の貼り付け sh.Activate With ActiveSheet.Pictures.Insert(folderPath & "\" & imagePath(pIdx)) ' 画像の位置を指定 .Top = Range(targetRange).Top .Left = Range(targetRange).Left ' 画像の横幅を指定 .Width = Range(targetRange).Width End With pIdx = pIdx + 1 Next Next End Sub |
手順③ プログラムの貼り付け
手順①で表示した画面にコピーしたプログラムを貼り付けます。
手順④ プログラムの実行
画面の上部にある▶を押してプログラムを実行します。
ポップアップ画面が表示されますので、貼り付けたい写真を格納しているフォルダを選択してOKボタンを押します。
実行結果
各シートに４枚ずつの画像が貼り付けられています！！
まとめ
いかがだったでしょうか？
大量の画像をExcelに貼り付ける作業はまだまだ存在するのではないでしょうか？
今回はそのような作業を一瞬で終わらせる方法をご紹介しました。
今後も業務を時短できる方法をご紹介していきます。
こういった業務を自動化したいというご要望がありましたら、コメントしていただけましたら幸いです！
コメント