Scribd
Upload
114 views12 pages

Employee Data Management System

The document contains VBA code for managing employee and contract data across multiple sheets in an Excel workbook. It includes subroutines for adding, updating, deleting and searching employee records, as well as adding and renewing contract records. Validation is performed to check that required fields are complete before adding or updating data.

Uploaded by

Wasroni Rengaspendawa
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
114 views12 pages

Employee Data Management System

The document contains VBA code for managing employee and contract data across multiple sheets in an Excel workbook. It includes subroutines for adding, updating, deleting and searching employee records, as well as adding and renewing contract records. Validation is performed to check that required fields are complete before adding or updating data.

Uploaded by

Wasroni Rengaspendawa
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

Coding sheet1

Dim ErwinG As String

Sub TambahData()

Dim DataPegawai As Object

Dim GBARANG As String

GBARANG = [Link]("Emp_Id").Value

Set DataPegawai = [Link]("C100000").End(xlUp)

If [Link]("Emp_Id").Value = "" _

Or [Link]("D4").Value = 1 _

Or [Link]("Emp_Name").Value = "" _

Or [Link]("Emp_Job").Value = "" _

Or [Link]("Emp_Dep").Value = "" _

Or [Link]("Emp_Hire").Value = "" _

Or [Link]("Emp_Phone").Value = "" _

Or [Link]("Emp_Email").Value = "" _

Or [Link]("Emp_BirthD").Value = "" _

Or [Link]("Emp_Image").Value = "" Then

Call MsgBox("Data pegawai harus lengkap atau data Id Employee telah digunakan", vbInformation,
"Data Pegawai")

Else

FileCopy ErwinG, [Link] & "\" & GBARANG & ".jpg"

[Link](1, 0).Value = [Link]("Emp_Id").Value

[Link](1, 1).Value = [Link]("Emp_Name").Value

[Link](1, 2).Value = [Link]("Emp_Job").Value

[Link](1, 3).Value = [Link]("Emp_Dep").Value

[Link](1, 4).Value = [Link]("Emp_Hire").Value


[Link](1, 5).Value = [Link]("Emp_Phone").Value

[Link](1, 6).Value = [Link]("Emp_Email").Value

[Link](1, 7).Value = [Link]("Emp_BirthD").Value

[Link](1, 8).Value = [Link]("Emp_Image").Value

Call MsgBox("Data pegawai berhasil ditambah", vbInformation, "Data Pegawai")

[Link]("Emp_Id").Value = ""

[Link]("Emp_Name").Value = ""

[Link]("Emp_Job").Value = ""

[Link]("Emp_Dep").Value = ""

[Link]("Emp_Hire").Value = ""

[Link]("Emp_Phone").Value = ""

[Link]("Emp_Email").Value = ""

[Link]("Emp_BirthD").Value = ""

[Link]("Emp_Image").Value = ""

[Link] = Nothing

[Link]

End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo ExcelVba

[Link] = False

If Not Intersect(Range("D17:D2000"), Target) Is Nothing And [Link] = 1 Then

Set FINDCODE = ActiveCell

Set FINDDATA = [Link]("D17:D20000").Find(What:=[Link], LookIn:=xlValues)

[Link]("Emp_Id").Value = [Link](0, -1).Value

[Link]("Emp_Name").Value = [Link](0, 0).Value

[Link]("Emp_Job").Value = [Link](0, 1).Value

[Link]("Emp_Dep").Value = [Link](0, 2).Value


[Link]("Emp_Hire").Value = [Link](0, 3).Value

[Link]("Emp_Phone").Value = [Link](0, 4).Value

[Link]("Emp_Email").Value = [Link](0, 5).Value

[Link]("Emp_BirthD").Value = [Link](0, 6).Value

[Link]("Emp_Image").Value = [Link](0, 7).Value

[Link] = LoadPicture([Link]("Emp_Image").Value)

End If

Exit Sub

ExcelVba:

Call MsgBox("Maaf, Foto Pegawai tidak ditemukan", vbInformation, "Foto Pegawai")

End Sub

Sub UpdateKaryawan()

Dim GBARANG As String

GBARANG = [Link]("Emp_Id").Value

Set UbahKaryawan = [Link]("C17:C10000").Find(What:=[Link]("Emp_Id").Value,


LookIn:=xlValues)

If [Link]("Emp_Id").Value = "" Then

Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")

Else

On Error Resume Next

FileCopy ErwinG, [Link] & "\" & GBARANG & ".jpg"

[Link](0, 1).Value = [Link]("Emp_Name").Value

[Link](0, 2).Value = [Link]("Emp_Job").Value

[Link](0, 3).Value = [Link]("Emp_Dep").Value

[Link](0, 4).Value = [Link]("Emp_Hire").Value

[Link](0, 5).Value = [Link]("Emp_Phone").Value

[Link](0, 6).Value = [Link]("Emp_Email").Value

[Link](0, 7).Value = [Link]("Emp_BirthD").Value

[Link](0, 8).Value = [Link]("Emp_Image").Value


Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")

[Link]("Emp_Id").Value = ""

[Link]("Emp_Name").Value = ""

[Link]("Emp_Job").Value = ""

[Link]("Emp_Dep").Value = ""

[Link]("Emp_Hire").Value = ""

[Link]("Emp_Phone").Value = ""

[Link]("Emp_Email").Value = ""

[Link]("Emp_BirthD").Value = ""

[Link]("Emp_Image").Value = ""

[Link] = Nothing

End If

End Sub

Sub Hapus_Data()

If [Link]("Emp_Id").Value = "" Then

Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")

Else

'Membuat pesan konfirmasi hapus data

Select Case MsgBox("Anda akan menghapus data" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")

Case vbNo

Exit Sub

Case vbYes

End Select

'Menentukan tempat hapus data, menghapus data dan membersihkan form


Set HapusData = [Link]("C17:C500000").Find(What:=[Link]("Emp_Id").Value,
LookIn:=xlValues)

[Link](0, 0).ClearContents

[Link](0, 1).ClearContents

[Link](0, 2).ClearContents

[Link](0, 3).ClearContents

[Link](0, 4).ClearContents

[Link](0, 5).ClearContents

[Link](0, 6).ClearContents

[Link](0, 7).ClearContents

[Link](0, 8).ClearContents

Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")

[Link]("Emp_Id").Value = ""

[Link]("Emp_Name").Value = ""

[Link]("Emp_Job").Value = ""

[Link]("Emp_Dep").Value = ""

[Link]("Emp_Hire").Value = ""

[Link]("Emp_Phone").Value = ""

[Link]("Emp_Email").Value = ""

[Link]("Emp_BirthD").Value = ""

[Link]("Emp_Image").Value = ""

[Link] = Nothing

Call UrutData

End If

End Sub

Sub UrutData()
[Link] = False

[Link]

[Link]("C16:L20000").Sort KEY1:=Range("C16"), Order1:=xlAscending, Header:=xlYes

End Sub

Sub ClearForm()

[Link]("Emp_Id").Value = ""

[Link]("Emp_Name").Value = ""

[Link]("Emp_Job").Value = ""

[Link]("Emp_Dep").Value = ""

[Link]("Emp_Hire").Value = ""

[Link]("Emp_Phone").Value = ""

[Link]("Emp_Email").Value = ""

[Link]("Emp_BirthD").Value = ""

[Link]("Emp_Image").Value = ""

[Link] = Nothing

End Sub

Sub BukaGambar()

On Error GoTo SALAH

Dim Erwin As Integer

[Link](msoFileDialogOpen).AllowMultiSelect = False

Erwin = [Link](msoFileDialogOpen).Show

If Erwin <> 0 Then

ErwinG = [Link](msoFileDialogOpen).SelectedItems(1)

[Link] = LoadPicture(ErwinG)

[Link] = 1

[Link]("Emp_Image").Value = [Link] & "\" & [Link]("Emp_Id").Value &


".jpg"

End If
Exit Sub

SALAH:

Call MsgBox("Tipe file tidak mendukung untuk ditampilkan, pastikan pilih file dengan tipe *.Jpg*, atau
*.Jpeg*", vbInformation, "Simpan Gambar")

End Sub

Sub KeFormKaryawan()

[Link]

End Sub
CODING SHEET2

Sub NewKontrak()

On Error GoTo ExcelVba

If [Link]("dURASI2").Value = "" Then

Call MsgBox("Pilih Nama Pegawai terlebih dahulu, lalu masukkan durasi kontrak terbaru",
vbInformation, "Hapus Data")

Else

Set CariPegawai = [Link]("C14:C100000").Find(What:=[Link]("Nama").Value,


LookIn:=xlValues)

[Link](0, 3).Value = [Link]("Durasi2").Value

[Link](0, 4).Value = [Link]("Akhir2").Value

[Link](0, 6).Value = "Renew"

[Link]("Nama").Value = ""

[Link]("Durasi2").Value = ""

Call MsgBox("Kontrak berhasil diperbarui", vbInformation, "Perbarui Kontrak")

End If

Exit Sub

ExcelVba:

Call MsgBox("Data Pegawai tidak ditemukan", vbInformation, "Data Pegawai")

End Sub

Sub TambahData1()

Dim DATAKONTRAK As Object

Set DATAKONTRAK = [Link]("C100000").End(xlUp)


If [Link]("KONTRAK_NAME").Value = "" _

Or [Link]("KONTRAK_DURATION").Value = "" Then

Call MsgBox("Data pegawai harus lengkap atau data Id Employee telah digunakan", vbInformation,
"Data Pegawai")

Else

[Link](1, 0).Value = [Link]("KONTRAK_NAME").Value

[Link](1, 1).Value = [Link]("KONTRAK_JOB").Value

[Link](1, 2).Value = [Link]("KONTRAK_START").Value

[Link](1, 3).Value = [Link]("KONTRAK_DURATION").Value

[Link](1, 4).Value = [Link]("KONTRAK_END").Value

Call MsgBox("Data pegawai berhasil ditambah", vbInformation, "Data Pegawai")

[Link]("KONTRAK_NAME").Value = ""

[Link]("KONTRAK_DURATION").Value = ""

[Link]

End If

End Sub

Sub HapusData2()

Select Case MsgBox("Anda akan menghapus data" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")

Case vbNo

Exit Sub

Case vbYes

End Select

[Link]

Call UrutData2
End Sub

Sub ClearForm()

[Link]("KONTRAK_NAME").Value = ""

[Link]("KONTRAK_DURATION").Value = ""

End Sub

Sub PilihData()

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'On Error GoTo ExcelVba

[Link] = False

If Not Intersect(Range("C14:C20000"), Target) Is Nothing And [Link] = 1 Then

'Set FINDCODE = ActiveCell

CELLAKTIF = [Link]

Sheets("KONTRAK").Range("C" & CELLAKTIF & ":K" & CELLAKTIF).Select

End If

End Sub

Sub UrutData2()

[Link] = False

[Link]

[Link]("C13:G140000").Sort KEY1:=Range("C13"), Order1:=xlAscending, Header:=xlYes

End Sub
CODING SHEET3

Sub Worksheet_Change(ByVal Target As Range)

If [Link] = "$F$4" Then

[Link] = LoadPicture([Link]("J7").Value)

[Link] = 1

End If

End Sub

Sub Cetak()

[Link]

End Sub

Sub Clear()

[Link]("F4").Value = ""

End Sub

CODING MODUL

Sub Employee()

[Link]

End Sub

Sub Kontrak()

[Link]

End Sub

Sub Profile()

[Link]

End Sub
Sub SaveData()

[Link]

End Sub

Sub Keluar()

[Link]

Select Case MsgBox("Anda akan keluar dari Aplikasi" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")

Case vbNo

Exit Sub

Case vbYes

End Select

[Link]

[Link]

End Sub

Common questions

Powered by AI

A new employee's data cannot be added if any of the following fields are empty: Emp_Id, Emp_Name, Emp_Job, Emp_Dep, Emp_Hire, Emp_Phone, Emp_Email, Emp_BirthD, Emp_Image, or if the Emp_Id has already been used .

When adding or updating employee records, the image file corresponding to each employee is copied to the current workbook's path using the employee ID with '.jpg' appended as the filename. This is handled by the FileCopy command, copying from the source specified by ErwinG to a destination assembled from the workbook's path and formatted with the employee ID .

The 'ClearForm' subroutine clears the values of all named ranges related to employee data entry fields, specifically resetting fields such as Emp_Id, Emp_Name, Emp_Job, Emp_Dep, Emp_Hire, Emp_Phone, Emp_Email, Emp_BirthD, and Emp_Image to empty. This is useful after data operations like adding, updating, or deleting to prepare the form for new input .

The system checks if the employee ID is empty or already used before proceeding with adding data by evaluating if Sheet1.Range('Emp_Id').Value is an empty string or already assigned. If so, a message box displays 'Data pegawai harus lengkap atau data Id Employee telah digunakan' to inform the user of the issue .

The application uses commands such as Employee, Kontrak, and Profile subroutines to switch between sheets Sheet1, Sheet2, and Sheet3 respectively. This structure enables users to navigate the application efficiently, associating each sheet with specific functions like managing employee data or contracts .

To add contract data, the TambahData1 subroutine creates a new entry at the end of the data range for contracts. Before this data is added, checks on 'KONTRAK_NAME' and 'KONTRAK_DURATION' ensure they are not empty, preventing incomplete data. Following these checks, the values from fields like 'KONTRAK_NAME', 'KONTRAK_JOB', 'KONTRAK_START', 'KONTRAK_DURATION', and 'KONTRAK_END' are written, and a message box confirms that the operation was successful .

To update the contract duration, the NewKontrak procedure finds the employee using the employee's name in column C, sets the 'Durasi2' range value as the new duration in the correct offset column, and sets the contract status to 'Renew'. Upon successful update, a message box notifies the user with 'Kontrak berhasil diperbarui' .

The 'UrutData' subroutine is called after employee data is deleted. Its function is to sort the data in ascending order based on the employee ID found in column C, from row 16 through row 20000, ensuring that any remaining data is ordered and easier to manage .

To remove an employee's data, the Hapus_Data subroutine first checks if the Emp_Id field is empty. If not, it prompts the user with a confirmation message 'Anda akan menghapus data Apakah anda yakin?' to ensure the user intends to proceed. Upon user confirmation, it finds the employee data range by Emp_Id, clears the contents across defined fields, and finally cleans the entry form. This process ensures deliberate user actions and maintains data integrity by removing only verified entries .

When loading employee images, the system uses error handling with an On Error GoTo statement to redirect to a custom error message. If an unsupported file type is selected, the system displays a message box error saying 'Tipe file tidak mendukung untuk ditampilkan, pastikan pilih file dengan tipe *.Jpg*, atau *.Jpeg*' to inform the user that only jpg or jpeg file types are allowed .

You might also like