Data Entry Form Connected With Database (Excel Sheet)




VBA Code -

Option Explicit

Dim curRecNo As Long

Private Sub btnFirst_Click()
    
    If Me.cmbEmpName.ListCount > 0 Then
    
        Me.cmbEmpName.ListIndex = 0
        
        curRecNo = Me.cmbEmpName.ListIndex + 1
        Me.lblCurrentRecNo.Caption = "Record No.: " & curRecNo
        
    End If
    
End Sub

Private Sub btnLast_Click()
    If Me.cmbEmpName.ListCount > 0 Then
    
        Me.cmbEmpName.ListIndex = Me.cmbEmpName.ListCount - 1
        
        curRecNo = Me.cmbEmpName.ListCount
        Me.lblCurrentRecNo.Caption = "Record No.: " & curRecNo
        
    End If
        
End Sub

Private Sub btnNext_Click()
    
    If Me.cmbEmpName.ListCount > 0 Then
    
        If Me.cmbEmpName.ListIndex = Me.cmbEmpName.ListCount - 1 Then
        
            Me.cmbEmpName.ListIndex = 0
            
        Else
        
            Me.cmbEmpName.ListIndex = Me.cmbEmpName.ListIndex + 1
            
        End If
        
        curRecNo = Me.cmbEmpName.ListIndex + 1
        Me.lblCurrentRecNo.Caption = "Record No.: " & curRecNo
    
    End If
    
End Sub

Private Sub btnPrevious_Click()
    
    If Me.cmbEmpName.ListCount > 0 Then
    
        If Me.cmbEmpName.ListIndex = 0 Then
        
            Me.cmbEmpName.ListIndex = Me.cmbEmpName.ListCount - 1
            
        Else
        
            Me.cmbEmpName.ListIndex = Me.cmbEmpName.ListIndex - 1
        
        End If
    
        curRecNo = Me.cmbEmpName.ListIndex + 1
        Me.lblCurrentRecNo.Caption = "Record No.: " & curRecNo
        
    End If
    
End Sub

Private Sub btnSearch_Click()
    
    Dim searchStr As String
    Dim idx As Integer
    
    searchStr = Me.tbFind.Text
    
    Me.lstFind.Clear
    
    For idx = 0 To Me.cmbEmpName.ListCount - 1
    
        If VBA.InStr(1, VBA.LCase(Me.cmbEmpName.List(idx)), VBA.LCase(searchStr)) Then
        
            Me.lstFind.AddItem (Me.cmbEmpName.List(idx))
            
        End If
    
    Next idx
    
    If Me.lstFind.ListCount > 0 Then
    
        Me.lstFind.ListIndex = 0
    
    Else
    
        MsgBox ("This record does not exist in database")
        
    End If
    
End Sub

Private Sub cmbEmpName_Click()
    
    Dim Ws As Worksheet
    Dim CRow As Integer, TRow As Integer
    
    Dim empNameID() As String
    Dim empName As String, empID As String
    
    Set Ws = Sheets("Employee Records")
    
    empNameID = VBA.Split(Me.cmbEmpName.Text, " - ")
    empName = empNameID(0)
    empID = empNameID(1)
    
    Me.tbEmpID.Text = empID
    Me.tbEmpName.Text = empName
    
    TRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
    
    For CRow = 2 To TRow
    
        If Ws.Range("A" & CRow).Value = empID Then
            
            Me.tbDesignation.Text = Ws.Range("C" & CRow).Value
            Me.tbGender.Text = Ws.Range("D" & CRow).Value
            Me.tbDOJ.Text = Ws.Range("E" & CRow).Value
            Me.tbAddress.Text = Ws.Range("F" & CRow).Value
            
            '********* image ***********
            
            If VBA.Dir(ThisWorkbook.Path & "\Employee Images\" & empID & ".jpg") <> "" Then
                Me.imgEmpImage.Picture = LoadPicture(ThisWorkbook.Path & "\Employee Images\" & empID & ".jpg")
            Else
                Me.imgEmpImage.Picture = LoadPicture(ThisWorkbook.Path & "\Employee Images\" & "No Image.jpg")
            End If
            
            '***************************
            
            GoTo EX1
            
        End If
    
    Next CRow
    
EX1:
    
    curRecNo = Me.cmbEmpName.ListIndex + 1
    Me.lblCurrentRecNo.Caption = "Record No.: " & curRecNo
    
End Sub



Private Sub CommandButton1_Click()
    UF_InsertAllPictures.Show
End Sub

Private Sub lstFind_Click()
    Me.cmbEmpName.Text = Me.lstFind.Text
End Sub

Private Sub UserForm_Initialize()
        
    Dim CRow As Integer, TRow As Integer
    Dim Ws As Worksheet
    
    Set Ws = Sheets("Employee Records")
    
    TRow = Ws.Range("B" & Rows.Count).End(xlUp).Row
    
    Me.cmbEmpName.Clear
    
    For CRow = 2 To TRow
    
        Me.cmbEmpName.AddItem Ws.Range("B" & CRow).Value & " - " & Ws.Range("A" & CRow).Value
    
    Next CRow
    
    If Me.cmbEmpName.ListCount > 0 Then
        Me.cmbEmpName.ListIndex = 0
        
        curRecNo = Me.cmbEmpName.ListIndex + 1
        Me.lblCurrentRecNo.Caption = "Record No. : " & Me.cmbEmpName.ListIndex + 1
        
    End If
    
    
    
End Sub


YouTube Video Links -














Comments

Post a Comment

Popular posts from this blog

Excel VBA To Send Data From Excel Sheet To The Google Sheet

Image
  VBA Code - Option Explicit Private Sub btnSendDataToGoogleSheet_Click()     Dim EmpId As Long, EmpName As String, Address As String, Gender As String, Desi As String     Dim HeaderName As String, SendID As String, Url1 As String, Url2 As String, FinalUrl As String     Dim TicketInfo As ServerXMLHTTP60     Dim TRow As Long, CRow As Long     TRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row     If TRow < 2 Then Exit Sub     For CRow = 2 To TRow         EmpId = Sheet1.Range("A" & CRow).Value         EmpName = Sheet1.Range("B" & CRow).Value         Address = Sheet1.Range("C" & CRow).Value         Gender = Sheet1.Range("D" & CRow).Value         Desi = Sheet1.Range("E" & CRow).Value         Url1 = "https://docs.google.com/forms/d/e/1FAIpQLSeUUjHkOE3H8YiIGHlmIymzKxsBuPDHN...
Read more

Excel VBA To Insert Multiple Images From A Folder To Worksheet

Image
  VBA Code - Option Explicit Private Sub btnInsertPictures_Click()     Dim photo As Shape     Dim ImgNameCol As Integer, ImgCol As Integer     Dim CCol As Integer, TCol As Integer     Dim CRow As Integer, TRow As Integer     Dim Ws As Worksheet     Dim imgno As Integer     imgno = 1     Set Ws = ActiveWorkbook.Sheets(Me.cmbSheets.Text)     '************ delete all images **************     Dim Shp As Shape     For Each Shp In Ws.Shapes         If VBA.Left(Shp.Name, 8) = "EmpImage" Then             Shp.Delete         End If     Next Shp     '*********************************************     CRow = Me.txtHeadingRow.Text     TCol = Ws.Cells(CRow, Columns.Count).End(xlToLeft).Column     For CCol = 1 To TCol   ...
Read more