History diff of Excelマクロ集(No. 3)

History
View the diff current.
View the source.
Go to Excelマクロ集.
- 1 (2009-11-14 (Sat) 16:44:42)
- 2 (2009-11-14 (Sat) 16:44:42)
- 3 (2009-11-21 (Sat) 00:16:10)

The added line is THIS COLOR.
The deleted line is THIS COLOR.

***選択範囲のセルの値が画像ファイルへのパスの場合、その画像をセルに配置するマクロ [#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};

#comment
----
[[CategoryMicrosoftOffice]]

History diff of Excelマクロ集 (No. 3)