1月 172014
 
機能:Excelのセールに指定される画像を表示する
[vb]
Sub insertPic()
' マクロ、https://51flya.com
On Error Resume Next
Application.ScreenUpdating = False 'ディスプレイの更新を中止する
Dim MR As Range
For Each MR In Selection
If Not IsEmpty(MR) And Dir(ActiveWorkbook.Path & "" & MR.Value & ".jpg") <> "" Then
MR.Select
ML = MR.Left
MT = MR.Top
MW = MR.Width
MH = MR.Height
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture _
ActiveWorkbook.Path & "" & MR.Value & ".jpg" '現在のセルの内容を現在のディレクトリにあるJPG画像ファイルにする。
End If
Next
Set MR = Nothing
Application.ScreenUpdating = True 'ディスプレイの更新を再開する
End Sub
[/vb]