エクセルではさまざまな方法で画像をワークシート、コントロール、その他に読み込むことが出来ます。
ここではOnActionプロパティーにマクロを登録できる、テキストを追加できる、という点からShapeを使って画像管理をする方法を考えます。
以下のサンプルでは、ワークシートにサムネイル状にShapeを配置し、FileSearchオブジェクトを使用して検索したビットマップファイルをUserPictureメソッドを用いて読み込みます。また、Shapeのクリックにより該当ファイルをユーザフォームのImageコントロールに読み込みます。
（前提）ワークシート：１、ユーザフォーム：１（Imageコントロール貼り付け）
Sub Thumnails()
ActiveSheet.DrawingObjects.Delete'シート上のShapeをすべて削除
Application.Cursor = xlWait
Application.ScreenUpdating = False
Dim TargetPath As String
Dim Cnt As Integer
Dim i As Integer, R As Integer, C As Integer
Dim L As Double, T As Double, W As Double, H As Double
Dim Sh As Shape
'セル幅、高さ等の設定
ActiveSheet.Rows.RowHeight = 5
ActiveSheet.Columns.ColumnWidth = 2
For Cnt = 2 To 20 Step 2
ActiveSheet.Rows(Cnt).RowHeight = 60
ActiveSheet.Columns(Cnt).ColumnWidth = 15
Next Cnt
TargetPath = Environ("windir")
'”Windows”フォルダ内のBmpファイルを検索します
With Application.FileSearch
.NewSearch
.Filename = "*.bmp"
.FileType = msoFileTypeAllFiles
.LookIn = TargetPath
.SearchSubFolders = False
.Execute
R = 2: C = 2 'Shape配置開始セル指定
For i = 1 To .FoundFiles.Count
If R > 10 Then R = 2: C = C + 2 '1行に5個のShape、1列あけて次の列へ
With ActiveSheet.Cells(R, C)
L = .Left: T = .Top: W = .Width: H = .Height 'Shapeの位置決め
End With
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, L, T, W, H)
Sh.Fill.UserPicture picturefile:=.FoundFiles(i) 'Pictureの指定
Sh.TextFrame.Characters.Text = Mid(.FoundFiles(i), _
InStr(Len(TargetPath), .FoundFiles(i), "\") + 1) 'ファイル名を表示
Sh.TextFrame.Characters.Font.Color = vbWhite '文字色設定
Sh.TextFrame.Characters.Font.Bold = True '太字
Sh.TextFrame.VerticalAlignment = xlVAlignBottom '垂直方向の位置
Sh.TextFrame.HorizontalAlignment = xlHAlignRight '水平方向の位置
Sh.OnAction = "DisplayPicture" 'マクロの登録
R = R + 2 '行カウンタ
Next i
End With
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub
'上記プロシージャの実行でOnActionプロパティーに登録され、
'Shapeのクリックにより呼び出される
Sub DisplayPicture()
'ShapeのTextFrameからファイル名を取得してユーザフォーム上の
'イメージコントロールに読み込む
UserForm1.Image1.Picture = LoadPicture _
(Environ("windir") & "\" & _
ActiveSheet.Shapes(Application.Caller). _
TextFrame.Characters.Text)
UserForm1.Show
End Sub
※画像を大量にShapeへ読み込んだことによるファイル保存時のサイズ肥大化は
終了時に以下のような方法でShapeの全削除を行うことで回避できます。
（削除法１）
ActiveSheet.Shapes.SelectAll
Selection.Delete
（削除法２）
ActiveSheet.DrawingObjects.Delete
※上記Thumnailサンプルでは、複数回の実行を前提に、プロシージャの先頭に削除法２の手法を取り入れてShapeの全削除を行っています。
※上記Thumnailでは、Shapeにファイル名を表示する際、フルパスからのファイル名取得にMid関数、Instr関数、Len関数を組み合わせていますが、エクセル2000の場合にはInstrRev関数やSplit関数があります。これらの詳細についてはヘルプやテクニック集の他のトピックを参照してください。
