Seemed easy to follow until i noticed that he added underscores to the NAMES and not others? I'm not a coder just trying to get a functional form.. how do i get your code to copy and paste?
Hello @kathrynbauer8641, You can get the code from the article, link is given in the description. I'm attaching it here too: www.exceldemy.com/how-to-create-a-database-in-excel-with-pictures/ Here is the VBA code: Option Explicit: Dim database As Worksheet Dim imagePath As Variant Dim db_range As String Dim r As Long 'representing first empty row from the top Public Function lastRow(ws As Worksheet) As Long lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row End Function Private Sub UserForm_Activate() Set database = Worksheets("Sheet1") r = lastRow(database) + 1 db_range = "A1:G" & r End Sub Private Sub cmdSave_Click() On Error Resume Next r = lastRow(database) + 1 database.Range("A1").Cells(r, 1) = Database_Entry_Form.txtEmpNo.Value database.Range("A1").Cells(r, 2) = Database_Entry_Form.txtEmpName.Value database.Range("A1").Cells(r, 3) = Database_Entry_Form.txt_Add.Value database.Range("A1").Cells(r, 4) = Database_Entry_Form.txt_Tel.Value database.Range("A1").Cells(r, 5) = Database_Entry_Form.txt_Designation.Value database.Range("A1").Cells(r, 6) = Database_Entry_Form.txt_DOB.Value If (IsNull(img_Emp.Picture)) Then 'do nothing Else Dim selectedCell As Range Dim imgHeight As Long Dim imgWidth As Long Dim imgRatio As Double Dim img As Shape 'get selected cell Set selectedCell = database.Range("A1").Cells(r, 7) 'get image height and width imgHeight = img_Emp.Picture.Height imgWidth = img_Emp.Picture.Width 'resize image height to 40 while maintaining aspect ratio imgRatio = imgHeight / imgWidth imgHeight = 40 imgWidth = imgHeight / imgRatio 'set row height of selected cell to match image height selectedCell.EntireRow.RowHeight = imgHeight + 5 selectedCell.HorizontalAlignment = xlCenter selectedCell.VerticalAlignment = xlCenter 'insert image in selected cell Set img = ActiveSheet.Shapes.AddPicture(Filename:=imagePath, _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Left:=selectedCell.Left + (selectedCell.Width - imgWidth) / 2, _ Top:=selectedCell.Top + (selectedCell.Height - imgHeight) / 2, _ Width:=imgWidth, _ Height:=imgHeight) img.Name = "Pic" & Database_Entry_Form.txtEmpNo.Value End If Call ExtendNamedRange End Sub Regards ExcelDemy
Hello @mochamadfikri7921, You are most welcome. we are so glad to hear that you found our video helpful. Keep leaning Excel with ExcelDemy. Regards ExcelDemy
Hello @katchylicious, You can follow our article Step-5 to create the search system: www.exceldemy.com/how-to-create-a-database-in-excel-with-pictures/#search-system You also can copy the given VBA code and paste it in the Module to create the search system: Sub ExtendNamedRange() Dim lastRow As Long Dim ws As Worksheet Dim namedRange As Range Set ws = ThisWorkbook.Worksheets("Sheet1") Set namedRange = ws.Range("A1").CurrentRegion lastRow = namedRange.Rows.Count With ws .Names.Add Name:="db_Sheet", RefersTo:=.Range("A1:G" & lastRow) End With End Sub Sub DeleteAllPictures() Dim pic As Shape For Each pic In ActiveSheet.Shapes If pic.Type = msoPicture Then pic.Delete End If Next pic End Sub Sub Get_Details() Dim look_up_Value As Variant Dim look_up_Range As Range Dim result As Variant ' Set the lookup value look_up_Value = Worksheets("Sheet2").Range("F5").Value ' Set the lookup range Set look_up_Range = Worksheets("Sheet1").Range("db_Sheet") ' Perform the VLOOKUP and store the result For i = 1 To 5 Worksheets("Sheet2").Range("C5").Cells(i, 1).Value _ = Application.WorksheetFunction.VLookup(look_up_Value, look_up_Range, i + 1, False) Next i End Sub Sub Employee_Pic() On Error GoTo ErrHandl 'Deleting Existing Pictures Call DeleteAllPictures Dim picName As String Dim picHeight As Double Dim picWidth As Double picName = "Pic" & Range("F5").Value 'Copy the picture from Sheet1 and paste it into Sheet2 Sheets("Sheet1").Shapes(picName).Copy Sheets("Sheet2").Range("C4").PasteSpecial 'Name the pasted picture in Sheet2 with the original name from Sheet1 Sheets("Sheet2").Shapes(Sheets("Sheet2").Shapes.Count).Name = picName 'Set the height and width of the cell to match the pasted picture's dimensions 'determining actual pic width and height picHeight = Sheets("Sheet2").Shapes(picName).Height picWidth = Sheets("Sheet2").Shapes(picName).Width 'determining aspect ration aspect_Ratio = picWidth / picHeight picHeight = Sheets("Sheet2").Range("C4").RowHeight - 5 picWidth = aspect_Ratio * picHeight 'Setting new height and width Sheets("Sheet2").Shapes(picName).Height = picHeight Sheets("Sheet2").Shapes(picName).Width = picWidth 'Center and middle align the pasted picture inside the cell Cell_Height = Sheets("Sheet2").Range("C4").Height Cell_Width = Sheets("Sheet2").Range("C4").Width With Sheets("Sheet2").Shapes(picName) .Top = Sheets("Sheet2").Range("C4").Top + (Cell_Height / 2) - (.Height / 2) .Left = Sheets("Sheet2").Range("C4").Left + (Cell_Width / 2) - (.Width / 2) End With Call Get_Details Exit Sub ErrHandl: MsgBox "No Data Found of this employee" For i = 1 To 5 Worksheets("Sheet2").Range("C5").Cells(i, 1).Value = "Not Found" Next End Sub Here is our Excel file link: www.exceldemy.com/wp-content/uploads/2023/05/how-to-create-a-database-in-excel-with-pictures-1.xlsm You will find the full database here. Regards ExcelDemy
Dear, The delete button is given to the database userform and the search option is given in another sheet. We will add the update button in our next video. Thanks for being with us.
Excellent video tutorial, but couldn't this be done completely in Visual Basic? I guess I don't see the need for it to be done in Excel, but maybe I'm missing something....
Dear, Thanks for the compliment. You're right. Using Visual Basic alone can be a more direct approach. But here, we have provided a solution for those who like working with Excel.
Hello @rabiuahmad2689, Thank you for your query. Yes, you correctly pointed out that it would be more convenient if we added an edit button for inserting new entries. However, regarding the delete button, there is already a delete button for removing the selected image. We appreciate your suggestion and feedback and hope to implement the changes soon. Regards ExcelDemy
Hello, Hanumantha! Please download the practice workbook, you will get the code there. Link: www.exceldemy.com/how-to-create-a-database-in-excel-with-pictures/#download Stay connected with Exceldemy for more helpful content! 🎉❤ Regards, Exceldemy Team!
Hello @user-cn7nq9yd6e @user-cn7nq9yd6e Thank you for your query. Yes, you correctly pointed out that it would be more convenient if we added an edit button for inserting new entries. However, regarding the delete button, there is already a delete button for removing the selected image. There is also a search button on another page. We appreciate your suggestion and feedback and hope to implement the changes soon. Regards ExcelDemy
