複数のセルを選択して同時に処理することもできる。DBに画像ファイルのパスのみ格納しててそれをExcelに出力したときに画像を配置できるので超便利。画像は自動でセルの中央に配置される。画像ファイルが見つからない場合、もしくはセルの値が画像でない場合は処理をスキップする。
Sub InsertPicture()
Dim margin As Double
margin = 1
On Error Resume Next
For Each cell In Selection.Cells
cell.Select
ActiveSheet.Pictures.Insert(cell.Value).Select
If Err.Number <> 0 Then
Err.Number = 0
GoTo EndOfForeach
End If
Selection.ShapeRange.LockAspectRatio = msoTrue
'Selection.Placement = xlMoveAndSize
Dim pictWidth As Double
Dim pictHeight As Double
Dim cellWidth As Double
Dim cellHeight As Double
pictWidth = Selection.Width
pictHeight = Selection.Height
cellWidth = cell.Width
cellHeight = cell.Height
If pictWidth / pictHeight > cellWidth / cellHeight Then
Selection.Height = (pictHeight * cellWidth) / pictWidth - margin
Selection.Width = cellWidth - margin
Else
Selection.Width = (pictWidth * cellHeight) / pictHeight - margin
Selection.Height = cellHeight - margin
End If
Selection.Top = cell.Top + (cell.Height - Selection.Height) / 2#
Selection.Left = cell.Left + (cell.Width - Selection.Width) / 2#
cell.Value = ""
EndOfForeach:
Next
End Sub