Coding sheet1
Dim ErwinG As String
Sub TambahData()
Dim DataPegawai As Object
Dim GBARANG As String
GBARANG = Sheet1.Range("Emp_Id").Value
Set DataPegawai = Sheet1.Range("C100000").End(xlUp)
If Sheet1.Range("Emp_Id").Value = "" _
Or Sheet1.Range("D4").Value = 1 _
Or Sheet1.Range("Emp_Name").Value = "" _
Or Sheet1.Range("Emp_Job").Value = "" _
Or Sheet1.Range("Emp_Dep").Value = "" _
Or Sheet1.Range("Emp_Hire").Value = "" _
Or Sheet1.Range("Emp_Phone").Value = "" _
Or Sheet1.Range("Emp_Email").Value = "" _
Or Sheet1.Range("Emp_BirthD").Value = "" _
Or Sheet1.Range("Emp_Image").Value = "" Then
Call MsgBox("Data pegawai harus lengkap atau data Id Employee telah digunakan", vbInformation,
"Data Pegawai")
Else
FileCopy ErwinG, ThisWorkbook.Path & "\" & GBARANG & ".jpg"
DataPegawai.Offset(1, 0).Value = Sheet1.Range("Emp_Id").Value
DataPegawai.Offset(1, 1).Value = Sheet1.Range("Emp_Name").Value
DataPegawai.Offset(1, 2).Value = Sheet1.Range("Emp_Job").Value
DataPegawai.Offset(1, 3).Value = Sheet1.Range("Emp_Dep").Value
DataPegawai.Offset(1, 4).Value = Sheet1.Range("Emp_Hire").Value
DataPegawai.Offset(1, 5).Value = Sheet1.Range("Emp_Phone").Value
DataPegawai.Offset(1, 6).Value = Sheet1.Range("Emp_Email").Value
DataPegawai.Offset(1, 7).Value = Sheet1.Range("Emp_BirthD").Value
DataPegawai.Offset(1, 8).Value = Sheet1.Range("Emp_Image").Value
Call MsgBox("Data pegawai berhasil ditambah", vbInformation, "Data Pegawai")
Sheet1.Range("Emp_Id").Value = ""
Sheet1.Range("Emp_Name").Value = ""
Sheet1.Range("Emp_Job").Value = ""
Sheet1.Range("Emp_Dep").Value = ""
Sheet1.Range("Emp_Hire").Value = ""
Sheet1.Range("Emp_Phone").Value = ""
Sheet1.Range("Emp_Email").Value = ""
Sheet1.Range("Emp_BirthD").Value = ""
Sheet1.Range("Emp_Image").Value = ""
Sheet1.Image1.Picture = Nothing
ThisWorkbook.Save
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExcelVba
Application.ScreenUpdating = False
If Not Intersect(Range("D17:D2000"), Target) Is Nothing And Target.Count = 1 Then
Set FINDCODE = ActiveCell
Set FINDDATA = Sheet1.Range("D17:D20000").Find(What:=FINDCODE.Value, LookIn:=xlValues)
Sheet1.Range("Emp_Id").Value = FINDCODE.Offset(0, -1).Value
Sheet1.Range("Emp_Name").Value = FINDDATA.Offset(0, 0).Value
Sheet1.Range("Emp_Job").Value = FINDDATA.Offset(0, 1).Value
Sheet1.Range("Emp_Dep").Value = FINDDATA.Offset(0, 2).Value
Sheet1.Range("Emp_Hire").Value = FINDDATA.Offset(0, 3).Value
Sheet1.Range("Emp_Phone").Value = FINDDATA.Offset(0, 4).Value
Sheet1.Range("Emp_Email").Value = FINDDATA.Offset(0, 5).Value
Sheet1.Range("Emp_BirthD").Value = FINDDATA.Offset(0, 6).Value
Sheet1.Range("Emp_Image").Value = FINDDATA.Offset(0, 7).Value
Sheet1.Image1.Picture = LoadPicture(Sheet1.Range("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 = Sheet1.Range("Emp_Id").Value
Set UbahKaryawan = Sheet1.Range("C17:C10000").Find(What:=Sheet1.Range("Emp_Id").Value,
LookIn:=xlValues)
If Sheet1.Range("Emp_Id").Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
On Error Resume Next
FileCopy ErwinG, ThisWorkbook.Path & "\" & GBARANG & ".jpg"
UbahKaryawan.Offset(0, 1).Value = Sheet1.Range("Emp_Name").Value
UbahKaryawan.Offset(0, 2).Value = Sheet1.Range("Emp_Job").Value
UbahKaryawan.Offset(0, 3).Value = Sheet1.Range("Emp_Dep").Value
UbahKaryawan.Offset(0, 4).Value = Sheet1.Range("Emp_Hire").Value
UbahKaryawan.Offset(0, 5).Value = Sheet1.Range("Emp_Phone").Value
UbahKaryawan.Offset(0, 6).Value = Sheet1.Range("Emp_Email").Value
UbahKaryawan.Offset(0, 7).Value = Sheet1.Range("Emp_BirthD").Value
UbahKaryawan.Offset(0, 8).Value = Sheet1.Range("Emp_Image").Value
Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")
Sheet1.Range("Emp_Id").Value = ""
Sheet1.Range("Emp_Name").Value = ""
Sheet1.Range("Emp_Job").Value = ""
Sheet1.Range("Emp_Dep").Value = ""
Sheet1.Range("Emp_Hire").Value = ""
Sheet1.Range("Emp_Phone").Value = ""
Sheet1.Range("Emp_Email").Value = ""
Sheet1.Range("Emp_BirthD").Value = ""
Sheet1.Range("Emp_Image").Value = ""
Sheet1.Image1.Picture = Nothing
End If
End Sub
Sub Hapus_Data()
If Sheet1.Range("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 = Sheet1.Range("C17:C500000").Find(What:=Sheet1.Range("Emp_Id").Value,
LookIn:=xlValues)
HapusData.Offset(0, 0).ClearContents
HapusData.Offset(0, 1).ClearContents
HapusData.Offset(0, 2).ClearContents
HapusData.Offset(0, 3).ClearContents
HapusData.Offset(0, 4).ClearContents
HapusData.Offset(0, 5).ClearContents
HapusData.Offset(0, 6).ClearContents
HapusData.Offset(0, 7).ClearContents
HapusData.Offset(0, 8).ClearContents
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Sheet1.Range("Emp_Id").Value = ""
Sheet1.Range("Emp_Name").Value = ""
Sheet1.Range("Emp_Job").Value = ""
Sheet1.Range("Emp_Dep").Value = ""
Sheet1.Range("Emp_Hire").Value = ""
Sheet1.Range("Emp_Phone").Value = ""
Sheet1.Range("Emp_Email").Value = ""
Sheet1.Range("Emp_BirthD").Value = ""
Sheet1.Range("Emp_Image").Value = ""
Sheet1.Image1.Picture = Nothing
Call UrutData
End If
End Sub
Sub UrutData()
Application.ScreenUpdating = False
Sheet1.Select
Sheet1.Range("C16:L20000").Sort KEY1:=Range("C16"), Order1:=xlAscending, Header:=xlYes
End Sub
Sub ClearForm()
Sheet1.Range("Emp_Id").Value = ""
Sheet1.Range("Emp_Name").Value = ""
Sheet1.Range("Emp_Job").Value = ""
Sheet1.Range("Emp_Dep").Value = ""
Sheet1.Range("Emp_Hire").Value = ""
Sheet1.Range("Emp_Phone").Value = ""
Sheet1.Range("Emp_Email").Value = ""
Sheet1.Range("Emp_BirthD").Value = ""
Sheet1.Range("Emp_Image").Value = ""
Sheet1.Image1.Picture = Nothing
End Sub
Sub BukaGambar()
On Error GoTo SALAH
Dim Erwin As Integer
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
Erwin = Application.FileDialog(msoFileDialogOpen).Show
If Erwin <> 0 Then
ErwinG = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Sheet1.Image1.Picture = LoadPicture(ErwinG)
Sheet1.Image1.PictureSizeMode = 1
Sheet1.Range("Emp_Image").Value = ThisWorkbook.Path & "\" & Sheet1.Range("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()
Sheet1.Select
End Sub
CODING SHEET2
Sub NewKontrak()
On Error GoTo ExcelVba
If Sheet2.Range("dURASI2").Value = "" Then
Call MsgBox("Pilih Nama Pegawai terlebih dahulu, lalu masukkan durasi kontrak terbaru",
vbInformation, "Hapus Data")
Else
Set CariPegawai = Sheet2.Range("C14:C100000").Find(What:=Sheet2.Range("Nama").Value,
LookIn:=xlValues)
CariPegawai.Offset(0, 3).Value = Sheet2.Range("Durasi2").Value
CariPegawai.Offset(0, 4).Value = Sheet2.Range("Akhir2").Value
CariPegawai.Offset(0, 6).Value = "Renew"
Sheet2.Range("Nama").Value = ""
Sheet2.Range("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 = Sheet2.Range("C100000").End(xlUp)
If Sheet2.Range("KONTRAK_NAME").Value = "" _
Or Sheet2.Range("KONTRAK_DURATION").Value = "" Then
Call MsgBox("Data pegawai harus lengkap atau data Id Employee telah digunakan", vbInformation,
"Data Pegawai")
Else
DATAKONTRAK.Offset(1, 0).Value = Sheet2.Range("KONTRAK_NAME").Value
DATAKONTRAK.Offset(1, 1).Value = Sheet2.Range("KONTRAK_JOB").Value
DATAKONTRAK.Offset(1, 2).Value = Sheet2.Range("KONTRAK_START").Value
DATAKONTRAK.Offset(1, 3).Value = Sheet2.Range("KONTRAK_DURATION").Value
DATAKONTRAK.Offset(1, 4).Value = Sheet2.Range("KONTRAK_END").Value
Call MsgBox("Data pegawai berhasil ditambah", vbInformation, "Data Pegawai")
Sheet2.Range("KONTRAK_NAME").Value = ""
Sheet2.Range("KONTRAK_DURATION").Value = ""
ThisWorkbook.Save
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
Selection.ClearContents
Call UrutData2
End Sub
Sub ClearForm()
Sheet2.Range("KONTRAK_NAME").Value = ""
Sheet2.Range("KONTRAK_DURATION").Value = ""
End Sub
Sub PilihData()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'On Error GoTo ExcelVba
Application.ScreenUpdating = False
If Not Intersect(Range("C14:C20000"), Target) Is Nothing And Target.Count = 1 Then
'Set FINDCODE = ActiveCell
CELLAKTIF = ActiveCell.Row
Sheets("KONTRAK").Range("C" & CELLAKTIF & ":K" & CELLAKTIF).Select
End If
End Sub
Sub UrutData2()
Application.ScreenUpdating = False
Sheet2.Select
Sheet2.Range("C13:G140000").Sort KEY1:=Range("C13"), Order1:=xlAscending, Header:=xlYes
End Sub
CODING SHEET3
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$4" Then
Sheet3.Image1.Picture = LoadPicture(Sheet3.Range("J7").Value)
Sheet3.Image1.PictureSizeMode = 1
End If
End Sub
Sub Cetak()
Sheet3.PrintPreview
End Sub
Sub Clear()
Sheet3.Range("F4").Value = ""
End Sub
CODING MODUL
Sub Employee()
Sheet1.Select
End Sub
Sub Kontrak()
Sheet2.Select
End Sub
Sub Profile()
Sheet3.Select
End Sub
Sub SaveData()
ThisWorkbook.Save
End Sub
Sub Keluar()
Sheet1.Select
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
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
