即効テクニック |
エクセルではさまざまな方法で画像をワークシート、コントロール、その他に読み込むことが出来ます。 ここでは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関数があります。これらの詳細についてはヘルプやテクニック集の他のトピックを参照してください。