These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Insert pictures

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 Sub

With 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

Document last updated 2000-04-15 12:51:27