Inserting a Picture into Shape Quickly

ando185

New Member
Joined
Jun 19, 2013
Messages
8
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?
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
here is some code that I have that inserts pictures into a shape

Code:
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

New Member
Joined
Jun 19, 2013
Messages
8
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

Well-known Member
Joined
May 19, 2002
Messages
8,458
oops I missed one

Code:
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

New Member
Joined
Jun 19, 2013
Messages
8
This isn't working for me... Do I have to assign this macro to each shape?
 

Watch MrExcel Video

Forum statistics

Threads
1,130,173
Messages
5,640,588
Members
417,152
Latest member
DayTimeSeby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top