Insert pictures
 

Hi everyone

I have several excel spreadsheets that has classlists of students. Each
spreadsheet has seperate columns for student number (eg 1234567), surname
(eg Blogg) and firstname (eg Joe). There is a folder that has photos of
students (jpegs), each photo is in a seperate file and the filename is
student_number.jpeg (eg 1234567.jpeg). I am looking to create another column
for photos in the spreadsheet and have a script that inserts the picture of
the student by fetching it from the folder which contains all the photos.
Any ideas on how to do this or the scripts from someone who has already done
this would be greatly appreciated.

Thanks in advance.

Insert pictures
 

Hi DC

The following code is not a script but it might give you an idea of
one way to show pictures depending on the value of a cell. This code
will generate a rectangle shape beside the selected cell and fill it
with the picture providing the selected cell ends in the JPG
extension. I hope this is of some use to you it is a little ruff
round the edges but it should work. Just paste the code below into
the module for the worksheet that holds the information.

'To Change the Folder that holds the pictures amend both instances of
line
'Selection.ShapeRange.Fill.UserPicture --- "C:\Pics\" --- &
Target.Value
'To change the shape to portrait change both instances of the line to
read like below
'MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 100, 200).Select

Option Explicit
Dim H, V As Integer
Dim MyDoc
Dim i As Integer
Dim MyChk As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set MyDoc = Sheets(1) 'Select which worksheet to work with

H = Target.Offset(0, 1).Left 'Gather details for placement of shape

V = Target.Offset(0, 1).Top

i = MyDoc.Shapes.Count 'Count shapes in the active worksheet

MyChk = Right(Target.Value, 4)


If Target.Cells.Count 1 Then 'Check if a range is selected

ClearShape

Exit Sub

End If

If Target.Value = "" Then 'Check if selected cell is empty

ClearShape

Exit Sub

End If

If MyChk = ".JPG" Then 'Check cell value ends with the JPG extension

If i 1 Then 'If a shape is open delete it then open a new one in
the new location

MyDoc.Shapes("Comment").Select

Selection.Delete

MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select

Selection.Name = "Comment" 'Name the shape

Selection.ShapeRange.Fill.UserPicture "C:\Pics\" &
Target.Value
'line above will put the picture in the shape
Else

MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select

Selection.Name = "Comment"

Selection.ShapeRange.Fill.UserPicture "C:\Pics\" &
Target.Value

End If

Else 'If the cell doesn't end with the JPG extension exit sub

ClearShape

Exit Sub

End If

End Sub
Sub ClearShape()

If i 1 Then 'If a shape is open close it

MyDoc.Shapes("Comment").Select

Selection.Delete

End If

End Sub

Take it easy

S

Insert pictures
 

Many thanks for that. Works well with a slight bit of tweaking to suit our
purpose.

Much appreciated.
DC


"Incidental" wrote in message
ups.com...
Hi DC

The following code is not a script but it might give you an idea of
one way to show pictures depending on the value of a cell. This code
will generate a rectangle shape beside the selected cell and fill it
with the picture providing the selected cell ends in the JPG
extension. I hope this is of some use to you it is a little ruff
round the edges but it should work. Just paste the code below into
the module for the worksheet that holds the information.

'To Change the Folder that holds the pictures amend both instances of
line
'Selection.ShapeRange.Fill.UserPicture --- "C:\Pics\" --- &
Target.Value
'To change the shape to portrait change both instances of the line to
read like below
'MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 100, 200).Select

Option Explicit
Dim H, V As Integer
Dim MyDoc
Dim i As Integer
Dim MyChk As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set MyDoc = Sheets(1) 'Select which worksheet to work with

H = Target.Offset(0, 1).Left 'Gather details for placement of shape

V = Target.Offset(0, 1).Top

i = MyDoc.Shapes.Count 'Count shapes in the active worksheet

MyChk = Right(Target.Value, 4)


If Target.Cells.Count 1 Then 'Check if a range is selected

ClearShape

Exit Sub

End If

If Target.Value = "" Then 'Check if selected cell is empty

ClearShape

Exit Sub

End If

If MyChk = ".JPG" Then 'Check cell value ends with the JPG extension

If i 1 Then 'If a shape is open delete it then open a new one in
the new location

MyDoc.Shapes("Comment").Select

Selection.Delete

MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select

Selection.Name = "Comment" 'Name the shape

Selection.ShapeRange.Fill.UserPicture "C:\Pics\" &
Target.Value
'line above will put the picture in the shape
Else

MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select

Selection.Name = "Comment"

Selection.ShapeRange.Fill.UserPicture "C:\Pics\" &
Target.Value

End If

Else 'If the cell doesn't end with the JPG extension exit sub

ClearShape

Exit Sub

End If

End Sub
Sub ClearShape()

If i 1 Then 'If a shape is open close it

MyDoc.Shapes("Comment").Select

Selection.Delete

End If

End Sub

Take it easy

S