- The added line is THIS COLOR.
- The deleted line is THIS COLOR.
***選択範囲のセルの値が画像ファイルへのパスの場合、その画像をセルに配置するマクロ [#kefcf6ff]
複数のセルを選択して同時に処理することもできる。DBに画像ファイルのパスのみ格納しててそれをExcelに出力したときに画像を配置できるので超便利。画像は自動でセルの中央に配置される。画像ファイルが見つからない場合、もしくはセルの値が画像でない場合は処理をスキップする。
Sub InsertPicture()
On Error Resume Next
For Each cell In Selection.Cells
cell.Select
ActiveSheet.Pictures.Insert(cell.Value).Select
If Err.Number <> 0 Then
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
Selection.Width = cellWidth
Selection.Top = cell.Top + (cell.Height - Selection.Height) / 2
Else
Selection.Width = (pictWidth * cellHeight) / pictHeight
Selection.Height = cellHeight
Selection.Left = cell.Left + (cell.Width - Selection.Width) / 2
End If
cell.Value = ""
EndOfForeach:
Next
End Sub
----
[[CategoryMicrosoftOffice]]
HTML convert time: 0.002 sec.