Excelへの画像の挿入について

質問

仕事で、自社Webサイトで使用している全画像をExcelで管理することになりました。

最初は単純に「挿入＞図＞ファイルから」で１つ１つ入れていけばと考えていたのですが、いざ始めてみると大変効率が悪く、どうにか作業を単純化できないものかと考えています。

ＶＢＡでできるのではないか、と思ったのですが、ＶＢＡはこれまで使ったことがなく、できるのかできないのかすら分かりません。

最終的には、
・ある画像フォルダに含まれる全画像から、ファイル名と画像データを取得する。
・Ａ列をファイル名、Ｂ列を画像とし、１行に１画像を配置する。
・画像が隠れてしまわないよう、それぞれの行の高さを調整する。
ということがしたいのですが、ＶＢＡでどこまでできそうか、またＶＢＡに関する解説サイトなどを教えていただけたらと思います。
（ＶＢとＶＢＡの違いも分かっていませんが、ＶＢなら昔やったことがあります。）

どうぞよろしくお願いいたします。

回答No.1

papayuka · ベストアンサー

正直言って何故 Excel なんかで画像を管理する必要があるのか理解出来ませんが、、、
サンプルマクロを書きましたので、参考になれば。

１．新規ブックを開き、ツール－マクロ－VisualBasicEditor（以下VBE）を開きます。
２．VBE画面で 挿入－ 標準モジュール として出てきた画面に下記マクロをコピーして貼り付けます。
３．VBE画面を閉じます。
４．画像があるフォルダにこのブックを保存します。（必須）
５．ツール－マクロ－マクロで PictAdd を実行します。

例は マクロを含むブックと同じフォルダ内にある jpg ファイルを次々に挿入するものです。
挿入した画像をクリックすると大きくなったり、小さくなったりします。
テスト環境で試してみて下さい。

Sub PictAdd()
Dim pict As Shape, r As Range

With Application.FileSearch
　.NewSearch
　.LookIn = ThisWorkbook.Path
　.SearchSubFolders = False
　.Filename = "*.jpg"
　If .Execute() > 0 Then
　　For i = 1 To .FoundFiles.Count
　　　Set r = ActiveSheet.Range("B" & i)
　　　Set pict = ActiveSheet.Shapes.AddPicture _
　　　　　　(.FoundFiles(i), msoTrue, msoFalse, _
　　　　　　 r.Left, r.Top, r.Width, r.Height)
　　　　　　pict.OnAction = "PictClick"
　　　　　　r.Offset(0, -1).Value = Dir(.FoundFiles(i))
　　Next i
　End If
End With
　Columns(1).EntireColumn.AutoFit
End Sub

Private Sub PictClick()
　Dim myPict As Shape, myRange As Range
　Set myPict = ActiveSheet.Shapes(Application.Caller)
　Set myRange = myPict.TopLeftCell
　With myPict
　　　If (myPict.Height = myRange.Height) And _
　　　　 (myPict.Width = myRange.Width) Then
　　　　 .LockAspectRatio = msoTrue
　　　　 .ScaleHeight 1#, True
　　　　 .ScaleWidth 1#, True
　　　Else
　　　　 .LockAspectRatio = msoFalse
　　　　 .Left = myRange.Left
　　　　 .Top = myRange.Top
　　　　 .Height = myRange.Height
　　　　 .Width = myRange.Width
　　　End If
　End With
End Sub

このサンプルは 以前に Moug のメーリングリストで教わったコードを含んでいます。
http://www.moug.net/

お礼

回答ありがとうございます。
おかげさまで作業を単純化することができました。
本当にありがとうございました。