Insert Photos by a cell references into particular areas

[ultrawat]

I have a problem with a photo survey spreadsheet I am putting together.

I have a need to be able to insert a photo into a spreadsheet ...say to fill cells A1:D10..from a cell reference ...say D1.

Then on the same spreadsheet insert a photo into the spreadsheet ...say to fill cells A13:D23..from a cell reference ...say D13....etc, etc

In other words I need to enter the file name (& path) into a cell, and this photo appear in a set area and in a set size......multiple times on the same sheet

This may be repeated 100+ times.

I would really appreciate a solution that does not 'do in' my newbie mind??

 

[Damon Ostrander]

Hi ultrawat,

Take a look at the ShowPicD function in this posting:

http://www.mrexcel.com/board2/viewtopic.php?t=104322&start=30

I think you can use this to accomplish what you describe.

Damon

 

[Joe Was]

This code will add the picture who's name was added to Cell E10 to the area just below that cell:

Private Sub Worksheet_Change(ByVal Target As Range)
'Sheet Module code, like: Sheet1.
Dim myFlgFile$, x%

'Get selected flags name only.
If Target.Address <> "$E$10" Then Exit Sub

'Load active flags name.
myFlgFile = Range("F10").Value

'Remove current flag from sheet.
On Error GoTo myName
ActiveSheet.Shapes(myFlgFile).Select
GoTo myDel

myName:
x = x + 1

If ActiveSheet.Shapes.Item(x).Name = "" Then
GoTo myName
Else
ActiveSheet.Shapes.Item(x).Select
myFlgFile = Selection.Name
End If

myDel:
Selection.Cut

'Load selected flag file to sheet.
myFlgFile = Range("E10").Value
ActiveSheet.Pictures.Insert("U:\My Documents\My Pictures\" & myFlgFile & ".jpg").Select
Selection.Name = myFlgFile
Range("F10").Value = myFlgFile

Selection.ShapeRange.ScaleWidth 0.35, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.35, msoFalse, msoScaleFromTopLeft
Application.CommandBars("Picture").Visible = False

ActiveSheet.Shapes(myFlgFile).Select
Selection.ShapeRange.IncrementLeft 2#
Selection.ShapeRange.IncrementTop 16#
Range("A1").Select
End Sub

 

[ultrawat]

Thanks guys,

I am VERY new to VBA.... I cant seem to get Joe's solution to work. I have changed the path in the code to reflect where the photos are filed??

Can you step me through how I insert this code in a module and then run it?

Thanks again

 

[Joe Was]

Before you add the event code add a picture, size it and add its name to the trigger cell. Then add the event code. It should run automatically from then on.

 

[ultrawat]

Sorry Joe,

I AM really a new comer to VBA......Not sure what you mean "before you add the event code..." Sorry to be a pain....but could you please step me through the process like the dummy I am??

 

[ultrawat]

I got it to work.......but.....it does not do exactly what I need.

As per my original post, I need the photo to be inserted into a particular range and at a particular size......then repeat the whole process a number of times on each sheet.....

Hope you can help...I really appreciate it!

 

[Joe Was]

See code for change notes!
You can change the location of the picture and the size by changing the code below!

You also may need to change the extention for the pic file!

Private Sub Worksheet_Change(ByVal Target As Range)
'Sheet Module code, like: Sheet1.
Dim myPicSel$, myPicFile$

'Change this info!
'Get selected picture file name [not extenstion] from this cell only.
If Target.Address <> "$E$10" Then Exit Sub
myPicSel = Range("E10").Value
On Error GoTo myErr1

'Load active pic name.
myPicFile = Range("F10").Value

'Remove current picture from sheet.
ActiveSheet.Shapes(myPicFile).Select
Selection.Cut

myErr1:
myPicFile = myPicSel
On Error GoTo myEnd

'Change this info!
'Load selected picture file to sheet.
'Below this cell is where you want the picture to be added!
ActiveSheet.Range("A10").Select

'Change this info!
'Note: Folder path!
'Note: Picture type Extention!
ActiveSheet.Pictures.Insert("U:\Excel\Test\" & myPicFile & ".gif").Select
Selection.Name = myPicFile
Range("F10").Value = myPicFile

'Change picture size here.
Selection.ShapeRange.ScaleWidth 0.35, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.35, msoFalse, msoScaleFromTopLeft
Application.CommandBars("Picture").Visible = False

ActiveSheet.Shapes(myPicFile).Select
Selection.ShapeRange.IncrementLeft 2#
Selection.ShapeRange.IncrementTop 16#
Range("A1").Select

myEnd:
End Sub

 

[ultrawat]

Thanks Joe,

I really appreciate your help...... This works well..

How do I now duplicate this for the next photo. When I copy and paste I get an error. How do I call the sub a different name?

Also is there any way of having the photo insert at a fixed size, regardless of the size of the photo?

I reckon we are really close to my perfect solution???

Thanks again!

 

[Joe Was]

Just change:

Private Sub Worksheet_Change(ByVal Target As Range)

To:

Sub myName()

And change "Target" in the code to:

ActiveCell

The only way to have the photo show the same size for all photos is to build a UserForm and Put a Photo Frame in it, which is called by code and floats above any sheet you want.

To run the code for many sheets we need more info.

Do you want the same photo to be on different sheets within the same Workbook and these Sheets will allways be the same Or Different [they change: sometimes some sheets don't get the picture!] and will the location cell be the same or different [on one or more sheets than it is on the others [namely the first]]?

Do you just want to loop through all the Sheets in the Workbook and place the same photo in the same location just a different Sheet.

The type of code and the code itself is different depending on just what it is you want to do!