PIC

[sssb2000]

Does anyone know of a way of associating a cell with a picture?

for example, if you click on a button, the picture appears in cell A1?

thoughts?

 

[Datsmart]

Quick note on Joe's code:
Notice the comment line below the first line of each of his blocks of code.
That tells you where that code must be placed.

To paste code to a standard module;
Start the Visual Basic Editor (via Menu Tools, Macro, Visual Basic Editor, or press ALT+F11).
On the Insert menu in the VBE, click Module. (if necessary)
In the module (the white area at the right), paste your code
Note: All Macros start with "Sub MacroName()" and End with "End Sub"


To paste code to a Worksheet Module:
Right click the sheet tab you want to have the code act on.
Choose "View Code"
Paste the code in the panel that opens.

 

[sssb2000]

datsmart, thank you for the note.

Joe, thank you for your help last night.
i modified your code (shown below) and it "functionally" does exactly what i need. However, i will need to pass the file around to others so i would need to modify the code so that it can recognize pictures on a different sheet.

thoughts?

Sub AddPictureToCell()

Dim cell As Object
Dim ws As Worksheet
Dim myRange As Range
Dim myPhotos As ShapeRange

Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
Set myRng = ws.Range("D3:D12")

On Error GoTo noPics
Set myPhotos = ws.Pictures.ShapeRange

If myPhotos.Count > 0 Then myPhotos.Delete

noPics:
For Each cell In myRng
cell.ColumnWidth = 12
cell.RowHeight = 37

If cell.Offset(0, -1).Value = 1 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\a.jpg").Select
If cell.Offset(0, -1).Value = 2 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\b.jpg").Select
If cell.Offset(0, -1).Value = 3 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\c.jpg").Select
If cell.Offset(0, -1).Value = 4 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\d.jpg").Select
If cell.Offset(0, -1).Value = 5 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\e.jpg").Select
If cell.Offset(0, -1).Value = 6 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\f.jpg").Select
If cell.Offset(0, -1).Value = 7 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\g.jpg").Select
If cell.Offset(0, -1).Value = 8 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\h.gif").Select
If cell.Offset(0, -1).Value = 9 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\i.gif").Select
If cell.Offset(0, -1).Value = 10 Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\j.gif").Select
If cell.Offset(0, -1).Value = "" Then ws.Pictures.Insert("C:\Documents and Settings\s\Desktop\Images\k.jpg").Select


With Selection
.Top = cell.Top
.Left = cell.Left
.Width = cell.Width
.Height = cell.Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

Next cell
Application.ScreenUpdating = True

ActiveSheet.Range("H5").Select
End Sub

 

[Joe Was]

OK, to work this you need some setting up.

On Sheet3 [my code] or any other sheet name that you will be storing all the photos on, you copy each photo. The size or placement does not matter!

To ID each Photo that is now on that sheet [you need to know its ID Number for the code!] record a macro as you select each photo on that storage sheet [Each photo will have a new name, due to the copy to the storage sheet, like: "Photo 1" or "Photo 2"].

In my code the photo number is the key to setting up the IF Statements selection of the correct photo. Just add additional IF Statements to accomodate all your photos. The rest of the code is reused for as many "IF Statements" as you have, so you only need to add one line of code for each picture ID.


Sub AddSheetPictureToCell()
'Standard module code, like: Module1.
Dim myP
Dim ws As Worksheet
Dim myPRng As Object, myPhoto As Object

Application.ScreenUpdating = False
'The sheet that gets the new picture display!
Set ws = Worksheets("Sheet2")
'The cell that gets the new picture displayed in it!
Set myPRng = ws.Range("B8")

On Error GoTo noPics
Set myPhoto = ws.Pictures.ShapeRange
'Delete current display photo, if any!
If myPhoto.Count > 0 Then myPhoto.Delete

noPics:
'Adjust picture display cell's size.
myPRng.ColumnWidth = 7
myPRng.RowHeight = 30

'Picture to display key is here, one cell Right of the Picture cell!
If myPRng.Offset(0, 1).Value > 7 Then myP = "1"
If myPRng.Offset(0, 1).Value < 7 Then myP = "2"

'The storage sheet location of the data photos to choose from!
Sheets("Sheet3").Shapes("Picture " & myP).Copy
myPRng.Select
ActiveSheet.Paste

'Fit the display picture to the display cell's dimentions!
Set myPhoto = ws.Pictures.ShapeRange

With myPhoto
.Top = myPRng.Top
.Left = myPRng.Left
.Width = myPRng.Width
.Height = myPRng.Height
.Select
End With

Selection.Placement = xlMoveAndSize
Selection.PrintObject = True

Application.ScreenUpdating = True
'This is the cell that has the photo trigger for the photo you want to be displayed,
'this range is the same as "myPRng.Offset(0, 1)"!
ActiveSheet.Range("C8").Select
End Sub

 

[Joe Was]

sssb2000, don't sell yourself short, you do have a grasp, you just lack the vocabulary to communicate in VBA. Like any language the more you work with it the better you get at communicating.

 

[sergenelles]

Dear Joe,

I am in need of a code that the picture change as the reference cell cnage of picture name.
i m doing a offer sheet of 12 items, and the items change every week.
i need a picture so the people can take the offer sheet away and can use it to remember the look of the product

this code seems good, but I don't know how to allocate the cells in the VBA

my pictures are on column A
the picture name is on column B

the folder with all the pictures is on column J

I can do myself a drop down list for column A if this is more easy to implement

thank you for your input

please see under the code you wrote earlier

serge

code:

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 <> "$b$2" Then Exit Sub
myPicSel = Range("b2").Value
On Error GoTo myErr1

'Load active pic name.
myPicFile = Range("a2").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("C:\Documents and Settings\touchman\Desktop\products" & myPicFile & ".jpg").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