VBA code to insert image to shape fill

[ExcelLee]

Morning all,

I am seeking a VBA code to do the following. I have been trawling the internet trying to sort and also writing my own to no avail.

The document has multiple shapes included named Rectangle 1 through 10. These are to house images.

I am looking for a macro to automatically do the following.

Select the rectangle - fill options - select image screen (user selects the image in pop up window) - image fills shape.

Thanks in advance!

Lee

 

[EFANYoutube]

So you want 10 popups asking the use what image they want in each box?

 

[ExcelLee]

So you want 10 popups asking the use what image they want in each box?

Hi Efan,

I would like one macro for each (i can amend the macro for each rectangles name).

For example 1st macro button applies to rectangle 1 only. 2nd macro button to rectangle 2 only...etc.etc

 

[EFANYoutube]

This will ask user to chose a file when button is clicked
Please make 10 buttons and assign First code

Sub Btn1_Clicked()

to first button,

Sub Btn2_Clicked()

to second button but change

    ChangeAllPictures "Rectangle 1"

to

    ChangeAllPictures "Rectangle 2"

etc

Sub Btn1_Clicked() ' Make 10 of these and change the name, no need to duplicate anything else
    ChangeAllPictures "Rectangle 1"
End Sub


Function ChangeAllPictures(SelectedShape As String)

Dim ThisShape As Shape
Dim Img As String

'For Each ThisShape In ActiveSheet.Shapes
    'If ThisShape.Name Like "Rectangle*" Then
        With ActiveSheet.Shapes.Range(SelectedShape).Fill
            .Visible = msoTrue
            Img = SelectImage
            If Img = "Cancel" Then Exit Function
            .UserPicture Img
            .TextureTile = msoFalse
            .RotateWithObject = msoTrue
        End With
    'End If
'Next ThisShape
End Function


Function SelectImage() As String
Dim lr As Long
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .ButtonName = "Submit"
    .Title = "Select an image file"
    .Filters.Clear
    .Filters.Add "All Pictures", "*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;" _
        & "*.dib;*.rle;*.jif;*.emz;*.wmz;*.tif;*.tiff;*.svg;*.ico"
    
    If .Show = -1 Then
        Dim Img As Object
        SelectImage = .SelectedItems(1)
    Else
        MsgBox ("Cancelled.")
        SelectImage = "Cancel"
    End If
End With
End Function

 

[ExcelLee]

this works perfectly thank you!!