Directory w/ Pictures

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
365
Greetings all...

I am wondering if it is possible to have pictures sorted or displayed according to data in a specific cell. For instance if cell A1 = Bob, then cell A2 = picture of bob.

If this is possible, my next question is if it will follow that text around a spreadsheet?

As an example, if I add 3 more people and Bob is in A1 anymore, can I make his picture follow him to A5?

Any other suggestions or ideas would be entertained.

Thanks!
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
If you make the cell big enough to hold the picture then format the picture to Move and size with cell, then it will sort with the appropriate row. The row heights do not move with the data, so if the rows are different heights, the image may be compressed or expanded as it is sorted to different rows.
 
Upvote 0
Thanks for the replies...

CWatts, I think what I saw in the video may work but my question is how can I show the picture in the cell, not as a comment. Then the next question...is there a way that I can use this format for anywhere in the spreadsheet? Not necessarily in one column? For example if the pic name moved from A2 to F9 is there code that would work that when run would move the picture to that location as the file name will now be there?

Here is the code...not sure how to proceed.

Sub addpics()
For i = 2 To 7
PicName = "C:\Documents and Settings\Chad\My Documents\My Pictures\" & Cells(i, 1) & ".jpg"
With Cells(i, 1). ????
.Shape.Fill.UserPicture PicName
.Shape.Height = 200
.Shape.Width = 200
End With
Next i
End Sub

Thanks!
 
Upvote 0
Ok...I have been doing some work and found something that is working however over time I can see this becoming very labour intensive as people are added. Is there a way to set up the below code to check everything and insert the appropriate picturee without adding code for each cell?

Also, as these pictures will move around based on order (alphabetical)...can I set up a function that deletes all pictures prior to adjusting/adding the new one so there is no overlap of pics?

The size of the pictures is a constant and is done to the picture itself (200x200). I simply pre adjust the cell to fit the picture and whoala! My other question is, is there a way I can also set up the code to center each picture in it's own cell.

Thanks...see below:

Sub Macro1()

Range("A1").Select
If Range("A1") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("A1") & ".jpg" _
).Select
End If

Range("C1").Select
If Range("C1") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("C1") & ".jpg" _
).Select
End If

Range("E1").Select
If Range("E1") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("E1") & ".jpg" _
).Select
End If

Range("A4").Select
If Range("A4") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("A4") & ".jpg" _
).Select
End If

Range("C4").Select
If Range("C4") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("C4") & ".jpg" _
).Select
End If

Range("E4").Select
If Range("E4") > "" Then
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\" & Range("E4") & ".jpg" _
).Select
End If

End Sub
 
Upvote 0
Code:
Option Explicit

Sub DeleteAllPicturesFromActiveSheet()

    Dim lX As Long
    Dim lShapeCount As Long
    Dim iAnswer As Integer
    
    lShapeCount = ActiveSheet.Shapes.Count
    If lShapeCount > 1 Then
        iAnswer = MsgBox("Delete " & lShapeCount & " pictures from this worksheet?", vbOKCancel, "Delete Pictures")
        If iAnswer = vbOK Then
            For lX = lShapeCount To 1 Step -1
                ActiveSheet.Shapes(lX).Delete
            Next
        End If
    End If
    
End Sub

Sub AddPicturesInSpecifiedRange()

    Dim rngCheckRange As Range
    Dim rngCell As Range
    Dim lX As Long
    Dim sImageSourceDirectory As String
    
    Set rngCheckRange = Range("A1,C1,E1,A4,C4,E4") 'This could be a simple range instead ("A1:E4")
    sImageSourceDirectory = "C:\Documents and Settings\Chad\My Documents\My Pictures\CBTC Directory\"
    
    For Each rngCell In rngCheckRange
        If rngCell.Value > "" Then 'you could check for the right 4 characters being .jpg
            rngCell.Select
            ActiveSheet.Pictures.Insert(sImageSourceDirectory & rngCell.Value & ".jpg").Select
            If Selection.Width < rngCell.Width Then Selection.Left = rngCell.Left + (rngCell.Width - Selection.Width) / 2
            If Selection.Height < rngCell.Height Then Selection.Top = rngCell.Top + (rngCell.Height - Selection.Height) / 2
        End If
    Next

    Set rngCheckRange = Nothing
End Sub
 
Upvote 0

Forum statistics

Threads
1,217,448
Messages
6,136,686
Members
450,024
Latest member
Beagle263

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top