Hello,
I designed a Student Profile in excel using LOOKUP function. In this profile, near the Student Name title I created one drop down list of students. If I select a student, then Roll No, Admission No, Date of Admission, Date of Birth, Mother's Name, Father's Name, Residential Address etc are shown downwards one by one in the respective cell automatically. I also need to insert his/her passport size photo in the prescribed cell, according to the Admission Number cell value. All the students' photos are put in one folder, each one named as Admission Number. First I select one student name from the drop down list displayed in his/her profile page, then printout will be taken. After taking that page printout, I will select another student. That time the photo of the previous student should be removed and the photo of the newly selected student should be displayed. If you know how it works (using any function/macro) please help me.
Please help me out to find a solution for this problem.
Requirement:-
1. If I type an image file name in A1 Cell(for eg: 4455)of Excel sheet, then the image/ photo of the same file no.should be displayed in B1 Cell.
2. If I cancel or change the file name in A1 Cell (For eg:- Instead of 4455, if I type 4465), then the previous photo in the B1 Cell according to the old file name should be deleted and the new photo as per the new file name given in A1 Cell should be displayed.
Now I using below mentioned code. But this is not satisfy my requirements.
Sub Picture()
Range("B1").Select 'This is where picture will be inserted
Dim picname As String
picname = Range("A1") 'This is the picture name
ActiveSheet.Pictures.Insert("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("B1").Left
.Top = Range("B1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 95#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
End Sub
Sub Picture()
Dim picname As String
Range("B1").Select 'This is where picture will be inserted
picname = Range("A1") 'This is the picture name
On Error Resume Next
'delete previous pic
ActiveSheet.Pictures("ProfilePicture").Delete
Err.Clear
Err.Number = 0
On Error GoTo 0
If (Dir("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg") = vbNullString) Then Exit Sub
ActiveSheet.Pictures.Insert("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Name = "ProfilePicture"
.Left = Range("B1").Left
.Top = Range("B1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 95#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Intersect(Target, Range("A1")) Is Nothing) Then
Exit Sub
End If
Application.EnableEvents = False
Call Picture
Application.EnableEvents = True
End Sub
Dear Sir,
This mail is just to thank you for your great help. I did it as per the suggestions and instructions given by you and now I am highly satisfied with the result. Now my work is almost 99% success. If I have any doubt, I will keep in touch with You. Let me thank you once again from the bottom of my heart for your timely help.Thanks a lot......
- Posts
- 13
- Registration date
- Monday February 18, 2013
- Last seen
- October 1, 2013
- Feb 20, 2013 at 06:24 AM- Posts
- 13
- Registration date
- Monday February 18, 2013
- Last seen
- October 1, 2013
- Feb 20, 2013 at 06:35 AMSub Picture()
Range("B1").Select 'This is where picture will be inserted
Dim picname As String
picname = Range("A1") 'This is the picture name
ActiveSheet.Pictures.Insert("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("B1").Left
.Top = Range("B1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 95#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
End Sub
you need to have a
inside you can call that routine
I am not saying its 100%, but it is 95%. All it lack is delete
this is what you need to do
Sub Picture() Dim picname As String Range("B1").Select 'This is where picture will be inserted picname = Range("A1") 'This is the picture name On Error Resume Next 'delete previous pic ActiveSheet.Pictures("ProfilePicture").Delete Err.Clear Err.Number = 0 On Error GoTo 0 If (Dir("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg") = vbNullString) Then Exit Sub ActiveSheet.Pictures.Insert("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg").Select 'Path to where pictures are stored ''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This resizes the picture ''''''''''''''''''''''''''''''''''''''''''''''''''''''' With Selection .Name = "ProfilePicture" .Left = Range("B1").Left .Top = Range("B1").Top .ShapeRange.LockAspectRatio = msoFalse .ShapeRange.Height = 95# .ShapeRange.Width = 80# .ShapeRange.Rotation = 0# End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If (Intersect(Target, Range("A1")) Is Nothing) Then Exit Sub End If Application.EnableEvents = False Call Picture Application.EnableEvents = True End Sub- Posts
- 13
- Registration date
- Monday February 18, 2013
- Last seen
- October 1, 2013
- Feb 20, 2013 at 09:21 AMThis mail is just to thank you for your great help. I did it as per the suggestions and instructions given by you and now I am highly satisfied with the result. Now my work is almost 99% success. If I have any doubt, I will keep in touch with You. Let me thank you once again from the bottom of my heart for your timely help.Thanks a lot......
Thanks & Regards
Yours lovingly
Jinoob K Viswanathan.