Insert pictures
2000-04-15 Worksheets 0 213
With the macro below you can insert pictures at any range in a worksheet. The picture can be centered horizontally and/or vertically.
Sub TestInsertPicture() InsertPicture "C:\FolderName\PictureFileName.gif", Range("D10"), True, True End Sub Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean) ' inserts a picture at the top left position of TargetCell ' the picture can be centered horizontally and/or vertically Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCell t = .Top l = .Left If CenterH Then w = .Offset(0, 1).Left - .Left l = l + w / 2 - p.Width / 2 If l < 1 Then l = 1 End If If CenterV Then h = .Offset(1, 0).Top - .Top t = t + h / 2 - p.Height / 2 If t < 1 Then t = 1 End If End With ' position picture With p .Top = t .Left = l End With Set p = Nothing End SubWith the macro below you can insert pictures and fit them to any range in a worksheet.
Sub TestInsertPictureInRange() InsertPictureInRange "C:\FolderName\PictureFileName.gif", Range("B5:D10") End Sub Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) ' inserts a picture and resizes it to fit the TargetCells range Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With ' position picture With p .Top = t .Left = l .Width = w .Height = h End With Set p = Nothing End Sub