Sub InsertPhoto()
'
' InsertPhoto Macro
' Keyboard Shortcut: Ctrl+i
'
' ファイル名を記述したセルをActiveにした状態で実行し、
' 隣のセルにそのファイルの写真をリサイズして挿入する
PictFileName = ActiveCell.Value
' 隣のセルのシート内の座標を取得
photoLeft = ActiveCell.Offset(0, 1).Left
photoTop = ActiveCell.Offset(0, 1).Top
' ActiveCellの行の高さを変更する
ActiveCell.Rows("1:1").EntireRow.Select
Selection.RowHeight = 96
ActiveSheet.Pictures.Insert("C:\Pictures\105OLYMP\" &
PictFileName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
' 写真の座標を設定(ActiveCellの隣のCellの座標 + Cell内でのoffset を追加指定)
Selection.ShapeRange.Left = photoLeft + 15
Selection.ShapeRange.Top = photoTop + 2
' 写真のリサイズ
Selection.ShapeRange.Height = 90
' Selection.ShapeRange.Width = 340.5
' Selection.ShapeRange.Rotation = 0#
End Sub
