VBA code to insert a picture as shape background.

[amaresh achar]

Hi,

I have a rectangle shape say 5cm x 8cm in an excel sheet. My requirements are :

1. When I click on that rectangle shape, it should prompt me to select a picture.

2. After I select that picture, it should set that picture as the background of that rectangle shape.

3. Compress that picture to e-mail (96ppi) levels

Thanks in advance for the assistance.

 

[bobsan42]

Hi,
1. Insert the code below in a standard code module:

Sub setBackGround()
    Dim shName As String
    shName = Application.Caller
    Dim x As FileDialog
    Set x = BrowseForFile
    If x Is Nothing Then Exit Sub
    Dim fName As String
    fName = x.SelectedItems(1)
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes(shName)
    With shp.Fill
        .Visible = msoTrue
        .UserPicture fName
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
    DoEvents
    shp.Select
    SendKeys "%e", True
    SendKeys "~", True
    Application.CommandBars.ExecuteMso "PicturesCompress"
    ActiveCell.Select
    Set x = Nothing
    Set shp = Nothing
End Sub

Function BrowseForFile() As FileDialog
    Set BrowseForFile = Application.FileDialog(msoFileDialogFilePicker)
    With BrowseForFile
        .Title = "Select files"
        .AllowMultiSelect = False
        .Filters.Add "JPG files", "*.jp*g", 1
        .Filters.Add "All files", "*.*", 2
        If .Show = 0 Then Set BrowseForFile = Nothing
    End With
End Function

2. right-click on the shape and select Assign Macro ...
3. select setBackGround
you're all set

Points Of Attention:
1. I personally don't like the SendKeys method. For starters it messes with my Num-Lock status.
2. I would suggest compressing pictures before inserting - plenty of batch tools are available for this. Check out this thread also:
Re-Save and compress images from a folder
2. This code is put together quickly and is not extensively tested.