Directory w/ Pictures

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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!
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,848
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.
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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!
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,848
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
 

Watch MrExcel Video

Forum statistics

Threads
1,109,423
Messages
5,528,681
Members
409,829
Latest member
CFreeamaz

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top