Image as cell value

[sswilcox]

I've worked up a "bingo" game using Excel that I have used on many
different occasions with good success. It easily permits custom lists
of values and uses a series of RAND() and RANK() functions to populate
all of the game pieces. Recently, my wife hosted a baby shower and
wanted me to adapt my worksheet for "Baby Shower Bingo", with things
like diapers and rattles in the cells. However, she wanted pictures
instead of words. I ended up using my fuctions to populate each cell
with the name of the baby item and them manually dragging the
corresponding image into each cell. Then I would hit F9 to generate a
new random set of values and drag the images around again. I had to do
this for 50 bingo cards.

What I would have liked to do was make a "table" of the images, then
call out the appropriate image with VLOOKUP. I couldn't figure it out
though. Anyone have any ideas on how to accomplish this more
efficiently than I was able to come up with? BTW, that "Access rules"
guy need not respond. Looking for an Excel solution.

S

 

[Dave Peterson]

You ready to do some tweaking?

I created a new worksheet with all the pictures I wanted to choose from. I
called that worksheet "Pictures".

Each of the picture's names followed a naming convention:
Picture #
(like "Picture 1", "Picture 2", Picture 3", ..., "Picture 100")

Then I created my bingo form on another worksheet named Bingo.

I put the pictures in these columns:
myCols = Array("B", "E", "H", "K", "N")

And in these rows:
myRows = Array(2, 5, 8, 11, 14)

(25 pictures total)

And each picture that I placed on the worksheet was resized to be 2 by 2 cells.

(If you run this once, you'll see you have some blank rows/columns so you can
put titles in the rows and columns and separators between the columns/rows to
make it look pretty.)

You can adjust as much as you want to match your Bingo form. This code also
deletes any pictures on the Bingo worksheet when it starts.

Option Explicit
Sub testme()

Dim PictWks As Worksheet
Dim Wks As Worksheet
Dim myIndex() As Long
Dim TotalPictures As Long
Dim iCtr As Long
Dim jCtr As Long
Dim pCtr As Long
Dim TempVal As Long
Dim myCols As Variant
Dim myRows As Variant
Dim myCell As Range
Dim myPict As Picture

Set Wks = Worksheets("Bingo")
Set PictWks = Worksheets("Pictures")

myCols = Array("B", "E", "H", "K", "N")
myRows = Array(2, 5, 8, 11, 14)

TotalPictures = PictWks.Pictures.Count

If ((UBound(myCols) - LBound(myCols) + 1) _
* (UBound(myRows) - LBound(myRows) + 1)) _

TotalPictures Then

MsgBox "Not enough pictures!"
Exit Sub
End If

ReDim myIndex(1 To TotalPictures)

'Load all the numbers
For iCtr = 1 To TotalPictures
myIndex(iCtr) = iCtr
Next iCtr

'shuffle them
For iCtr = 1 To TotalPictures
jCtr = Int(TotalPictures * Rnd) + 1
TempVal = myIndex(iCtr)
myIndex(iCtr) = myIndex(jCtr)
myIndex(jCtr) = TempVal
Next iCtr

Application.ScreenUpdating = False

Wks.Pictures.Delete

pCtr = 0
For iCtr = LBound(myCols) To UBound(myCols)
For jCtr = LBound(myRows) To UBound(myRows)
pCtr = pCtr + 1
PictWks.Pictures("Picture " & myIndex(pCtr)).Copy
Wks.Paste
Set myPict = Wks.Pictures(Wks.Pictures.Count)
Set myCell = Wks.Cells(myRows(jCtr), myCols(iCtr)).Resize(2, 2)
With myPict
.Left = myCell.Left
.Top = myCell.Top
.Width = myCell.Width
.Height = myCell.Height
End With
Next jCtr
Next iCtr

Application.ScreenUpdating = True

End Sub

I took the sorting routine from a post by Dana DeLouis.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[sswilcox]

Wow! A very thorough answer Dave. Thanks for taking the time. I haven't
had time to work through this yet, but will definately give it a shot.
Thanks again.

S