Inserting a Picture into Shape Quickly

[ando185]

I am working with Excel for Mac 2011.

In the SmartArt section they have a picture tab, where you can select from various formats. None of these formats fit my needs. So my question is, can I customize these?

If not, can I add a macro to a shape so that it can do what the picture boxes do, opening the folder to select a photo, and put it into excel in the shape, location, and size of the shape?

 

[texasalynn]

here is some code that I have that inserts pictures into a shape

Sub TestInsertPicture()
Call Shapes1
sPath = "L:\ALynn\Graphic\"
sPict = Range("A1") & ".jpg"
    InsertPicture sPath & sPict, _
        Range("M4"), 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
Sub Shapes1()
'Delete all Objects except Comments
    On Error Resume Next
    ActiveSheet.DrawingObjects.Visible = True
    ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0
End Sub

 

[ando185]

I tried assigning this macro to the shape but it came back with a bug at this point.

If Dir(PictureFileName) = "" Then Exit Sub

Is there something I need to change to make it specific for my shape and/or sheet?

 

[texasalynn]

oops I missed one

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

 

[ando185]

This isn't working for me... Do I have to assign this macro to each shape?