Diff of Excelマクロ集

The added line is THIS COLOR.
The deleted line is THIS COLOR.
Go to Excelマクロ集.
Deleting diff of Excelマクロ集
***選択範囲のセルの値が画像ファイルへのパスの場合、その画像をセルに配置するマクロ [#kefcf6ff]
複数のセルを選択して同時に処理することもできる。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

***コメントをどーぞ [#g4aa676f]
- すばらしすぎるマクロの達人です --  &new{2009-11-21 (土) 00:14:43};
- Excel2010だと、このマクロを使用するとリンクオブジェクト扱いになってしまうのですが、図として挿入する方法があれば紹介していただきたいです。自分なりにやってみようとしたのですが、ハイレベルで歯が立ちませんでした｡ﾟ(ﾟ´Д｀ﾟ)ﾟ｡※リンクになる理由（マイクロソフトサポート）→http://support.microsoft.com/kb/2396509/ja -- [[可能であれば・・・]] &new{2011-08-19 (金) 18:23:24};

#comment
----
[[CategoryMicrosoftOffice]]