Scribd
Upload
17 views6 pages

UserForm1 Code

The document contains a VBA code for managing employee records in an Excel UserForm. It includes functionalities to add, modify, delete, and search for employee records, as well as to populate a ListView with data from a worksheet. The code also includes data validation and field clearing methods to ensure proper user input and interface usability.

Uploaded by

Algor Agbahid
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
17 views6 pages

UserForm1 Code

The document contains a VBA code for managing employee records in an Excel UserForm. It includes functionalities to add, modify, delete, and search for employee records, as well as to populate a ListView with data from a worksheet. The code also includes data validation and field clearing methods to ensure proper user input and interface usability.

Uploaded by

Algor Agbahid
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 6

Option Explicit

' Remplir le ListView en temps réel


Private Sub RemplirListView()
Dim ws As Worksheet
Dim ligne As Integer
Dim itm As ListItem

Set ws = ThisWorkbook.Sheets("Base de Donnée")

' Effacer le ListView avant de recharger


ListView1.ListItems.Clear

' Boucler sur les données de la feuille


For ligne = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
Set itm = ListView1.ListItems.Add(, , ws.Cells(ligne, 1).Value)
itm.SubItems(1) = ws.Cells(ligne, 2).Value
itm.SubItems(2) = ws.Cells(ligne, 3).Value
itm.SubItems(3) = ws.Cells(ligne, 4).Value
itm.SubItems(4) = ws.Cells(ligne, 5).Value
itm.SubItems(5) = ws.Cells(ligne, 6).Value
Next ligne
End Sub

' Enregistrer un employé


Private Sub BtnEnregistrer_Click()
Dim ws As Worksheet
Dim nouvelleLigne As Integer

Set ws = ThisWorkbook.Sheets("Base de Donnée")


nouvelleLigne = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

' Insérer les données


ws.Cells(nouvelleLigne, 1).Value = TxtID.Value
ws.Cells(nouvelleLigne, 2).Value = TxtNom.Value
ws.Cells(nouvelleLigne, 3).Value = TxtPrenom.Value
ws.Cells(nouvelleLigne, 4).Value = TxtPoste.Value
ws.Cells(nouvelleLigne, 5).Value = TxtEmail.Value
ws.Cells(nouvelleLigne, 6).Value = TxtTel.Value

' Rafraîchir ListView


RemplirListView
MsgBox "Enregistrement réussi !", vbInformation
End Sub
' Modifier un employé
Private Sub BtnModifier_Click()
Dim ws As Worksheet
Dim ligne As Integer
Dim trouve As Boolean

Set ws = ThisWorkbook.Sheets("Base de Donnée")


trouve = False

' Recherche de l'ID


For ligne = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(ligne, 1).Value = TxtID.Value Then
ws.Cells(ligne, 2).Value = TxtNom.Value
ws.Cells(ligne, 3).Value = TxtPrenom.Value
ws.Cells(ligne, 4).Value = TxtPoste.Value
ws.Cells(ligne, 5).Value = TxtEmail.Value
ws.Cells(ligne, 6).Value = TxtTel.Value
trouve = True
Exit For
End If
Next ligne

If trouve Then
RemplirListView
MsgBox "Modification réussie !", vbInformation
Else
MsgBox "ID introuvable", vbExclamation
End If
End Sub

' Supprimer un employé


Private Sub BtnSupprimer_Click()
Dim ws As Worksheet
Dim ligne As Integer
Dim trouve As Boolean

Set ws = ThisWorkbook.Sheets("Base de Donnée")


trouve = False

' Recherche de l'ID


For ligne = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(ligne, 1).Value = TxtID.Value Then
ws.Rows(ligne).Delete
trouve = True
Exit For
End If
Next ligne

If trouve Then
RemplirListView
MsgBox "Suppression réussie !", vbInformation
Else
MsgBox "ID introuvable", vbExclamation
End If
End Sub

' Rechercher un employé


Private Sub BtnRechercher_Click()
Dim ws As Worksheet
Dim ligne As Integer
Dim trouve As Boolean

Set ws = ThisWorkbook.Sheets("Base de Donnée")


trouve = False

' Recherche par ID


For ligne = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(ligne, 1).Value = TxtRecherche.Value Then
TxtID.Value = ws.Cells(ligne, 1).Value
TxtNom.Value = ws.Cells(ligne, 2).Value
TxtPrenom.Value = ws.Cells(ligne, 3).Value
TxtPoste.Value = ws.Cells(ligne, 4).Value
TxtEmail.Value = ws.Cells(ligne, 5).Value
TxtTel.Value = ws.Cells(ligne, 6).Value
trouve = True
Exit For
End If
Next ligne

If Not trouve Then


MsgBox "Aucun résultat trouvé", vbExclamation
End If
End Sub

' Charger ListView au démarrage


Private Sub UserForm_Initialize()
' Configuration ListView
With ListView1
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
.ColumnHeaders.Add , , "ID", 50
.ColumnHeaders.Add , , "Nom", 100
.ColumnHeaders.Add , , "Prénom", 100
.ColumnHeaders.Add , , "Poste", 100
.ColumnHeaders.Add , , "Email", 150
.ColumnHeaders.Add , , "Téléphone", 100
End With

' Charger les données


RemplirListView
End Subdd , , "Département", 100
.ColumnHeaders.Add , , "Salaire", 80
.ColumnHeaders.Add , , "Date d'embauche", 100
End With
End Sub

Private Sub LoadData()


Dim ws As Worksheet
Set ws = Sheets("Base de Donnee")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

ListView1.ListItems.Clear

For i = 2 To lastRow
With ListView1.ListItems.Add(, , ws.Cells(i, 1).Value)
.SubItems(1) = ws.Cells(i, 2).Value
.SubItems(2) = ws.Cells(i, 3).Value
.SubItems(3) = ws.Cells(i, 4).Value
.SubItems(4) = ws.Cells(i, 5).Value
.SubItems(5) = Format(ws.Cells(i, 6).Value, "Currency")
.SubItems(6) = Format(ws.Cells(i, 7).Value, "Short Date")
End With
Next i
End Sub

Private Sub btnEnregistrer_Click()


If ValidateFields Then
currentID = currentID + 1
SaveRecord currentID
ClearFields
LoadData
End If
End Sub

Private Sub btnModifier_Click()


If ListView1.SelectedItem Is Nothing Then Exit Sub
If ValidateFields Then
SaveRecord CLng(ListView1.SelectedItem.Text)
ClearFields
LoadData
End If
End Sub

Private Sub btnSupprimer_Click()


If ListView1.SelectedItem Is Nothing Then Exit Sub
If MsgBox("Supprimer cet employé ?", vbYesNo) = vbYes Then
DeleteRecord CLng(ListView1.SelectedItem.Text)
LoadData
End If
End Sub

Private Sub btnRechercher_Click()


FilterData txtSearch.Text
End Sub

Private Sub SaveRecord(id As Long)


Dim ws As Worksheet
Set ws = Sheets("Base de Donnee")
Dim rowNum As Long

rowNum = FindRow(id)

With ws
.Cells(rowNum, 1) = id
.Cells(rowNum, 2) = txtNom.Text
.Cells(rowNum, 3) = txtPrenom.Text
.Cells(rowNum, 4) = txtPoste.Text
.Cells(rowNum, 5) = txtDepartement.Text
.Cells(rowNum, 6) = CDbl(txtSalaire.Text)
.Cells(rowNum, 7) = CDate(txtDate.Text)
End With
End Sub
Private Sub DeleteRecord(id As Long)
Dim delRow As Long
delRow = FindRow(id)
If delRow > 1 Then
Sheets("Base de Donnee").Rows(delRow).Delete
End If
End Sub

Private Function FindRow(id As Long) As Long


Dim ws As Worksheet
Set ws = Sheets("Base de Donnee")
FindRow = ws.Columns(1).Find(id, LookIn:=xlValues).Row
End Function

Private Sub FilterData(searchTerm As String)


' Implémentez la logique de filtrage selon vos besoins
End Sub

Private Function ValidateFields() As Boolean


' Ajoutez la validation des champs
ValidateFields = True
End Function

Private Sub ClearFields()


txtNom.Text = ""
txtPrenom.Text = ""
txtPoste.Text = ""
txtDepartement.Text = ""
txtSalaire.Text = ""
txtDate.Text = ""
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)


With Item
txtNom.Text = .SubItems(1)
txtPrenom.Text = .SubItems(2)
txtPoste.Text = .SubItems(3)
txtDepartement.Text = .SubItems(4)
txtSalaire.Text = Replace(.SubItems(5), "$", "")
txtDate.Text = .SubItems(6)
End With
End Sub

You might also like