エクセルではさまざまな方法で画像をワークシート、コントロール、その他
に読み込むことが出来ます。
ここではOnActionプロパティーにマクロを登録できる、テキストを追加できる、
という点からShapeを使って画像管理をする方法を考えます。
以下のサンプルでは、ワークシートにサムネイル状にShapeを配置し、FileSearch
オブジェクトを使用して検索したビットマップファイルをUserPictureメソッドを
用いて読み込みます。また、Shapeのクリックにより該当ファイルをユーザフォーム
のImageコントロールに読み込みます。
(前提)ワークシート:1、ユーザフォーム:1(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の全削除を行うことで回避できます。
(削除法1)
ActiveSheet.Shapes.SelectAll
Selection.Delete
(削除法2)
ActiveSheet.DrawingObjects.Delete
※上記Thumnailサンプルでは、複数回の実行を前提に、プロシージャの先頭に
削除法2の手法を取り入れてShapeの全削除を行っています。
※上記Thumnailでは、Shapeにファイル名を表示する際、フルパスからのファイ
ル名取得にMid関数、Instr関数、Len関数を組み合わせていますが、エクセル
2000の場合にはInstrRev関数やSplit関数があります。これらの詳細について
はヘルプやテクニック集の他のトピックを参照してください。
|