DATA 1. Karyawan No
Nama
Bagian
NRK
Jabatan
Golongan Pendidikan
1 Ahmad Akbar
3.09
00.00.PL.01357 Tukang Listrik Sounsistim IC/0
STM
2 Denny Sariati Damanik
3.09
81.00.PL.01015 Mandor Traksi
IID/6
SMA
3 Effendi Nasution
3.09
79.00.PL.00781 Krani Admi Urta
ID/4
SMA
4 Erica Diana Simarmata
3.09
85.38.30418
Krani Admi Urta
IIB/6
SMA
5 Hariani
3.09
00.38.30704
Krani Admi Urta
IB/8
SMP
6 Luxsiana Sari, SE
3.09
06.00.PL.03541 Pembantu Krani Umum
IB/0
S1
Kantor IKBI 7 M.Syahril
3.09
99.00.PL.01938 Tukang Listrik Sounsistim IC/0
SMA
8 Masita
3.09
96.38.30577
Krani Admi Urta
IC/0
SMP
9 Rusmanto
3.09
92.00.PL.01224 Krani Admi Urta
ID/4
SMP
10 Sampirno
3.09
83.00.PL.00799 Krani Admi Urta
IIC/2
SMA
11 Sugiyanto
3.09
82.00.PL.01035 Krani Traksi
IID/0
SMP
12 Suhartono
3.09
93.00.PL.29933 Krani Admi Urta
IC/8
STM
13 Suriadi Manurung
3.09
90.00.PL.01183 Krani Traksi
ID/4
SD
14 Syaiful Daniel
3.09
87.00.PL.01129 Krani Admi Urta
IIA/2
SMEA
15 Willian Helmi
3.09
84.00.PL.00803 Krani I Admi Urta
IID/6
SMA
16 Yusta Minawaty
3.09
01.00.PL.31000 Pembantu Krani Umum
IC/2
S1
17 Dody Ardhyansyah Putra 3.09
04.24.02719
IB/6
SMA
18 Widi Santoso
3.09
09.00.PL.06137 Krani Admi Urta
IA/4
SMU
19 Darsimah
3.09
90.00.PL.01185 Pelayan Mess
IB/11
SD
20 Asiah P
3.09
00.00.PL.)1355 Pelayan Mess
IB/1
SMK
Tukang Listrik
Universitas Sumatera Utara
2. Data Cuti
Nama
NRK
Tgl_cuti
golongan
Denny Sariati Damanik
81.00.PL.01015
02/01/2013 IID/6
Erica Diana Simarmata
85.38.30418
02/01/2013 IIB/6
Hariani
00.38.30704
11/01/2013 IB/8
Sampirno
83.00.PL.00799
18/01/2013 IIC/2
Erica Diana Simarmata
85.38.30418
18/01/2013 IIB/6
Suhartono
93.00.PL.29933
29/01/2013 IC/8
Widi Santoso
09.00.PL.06137
30/01/2013 IA/4
Erica Diana Simarmata
85.38.30418
31/01/2013 IIB/6
Rusmanto
92.00.PL.01224
11/03/2013 ID/4
Suhartono
93.00.PL.29933
27/03/2013 IC/8
Syaiful Daniel
87.00.PL.01129
23/04/2013 IIA/2
Masita
96.38.30577
23/04/2013 IC/0
Suhartono
93.00.PL.29933
07/05/2013 IC/8
jabatan Mandor Traksi Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi Urta Krani Admi
cuti_yang_di sisa_cuti keterangan ambil 12 3 9 Urusan Keluarga
Hak_cuti
12
3
9 Urusan Keluarga
6
2
4 Urusan Keluarga
7
1
6 Urusan Keluarga
9
1
8 Urusan keluarga
11
1
10 -
6
1
5-
8
2
12
1
10
1
9 Urusan Keluarga
11
1
10 Urusan Keluarga
12
2
10 Urusan Keluarga
9
1
8 Urusan Keluarga
6 Urusan Keluarga ( Membawa Suami Berobat ) 11 Urusan Keluarga
Universitas Sumatera Utara
70
Nama Dody Ardhyansyah Putra
NRK 04.24.02719
Tgl_cuti
golongan
14/05/2013 IB/6
jabatan Urta Tukang Listrik
cuti_yang_di sisa_cuti ambil
Hak_cuti 7
2
keterangan
5 Urusan Keluarga
Universitas Sumatera Utara
LISTING PROGRAM
Frmmenu.frm
Private Sub mnudatacuti_Click() frmcuti.Show End Sub
Private Sub mnudatapegawai_Click() frmdatapegawai.Show End Sub
Private Sub mnuexit_Click() Dim MB As Byte MB = MsgBox("Anda Yakin Keluar...?", vbYesNo + vbInformation, "Pesan") If MB = vbYes Then End End If End Sub
Private Sub mnulapcuti_Click() crcuti.ReportFileName = App.Path & "\rptcuti.rpt" crcuti.Action = 1 End Sub
Private Sub mnulappegawai_Click() crpegawai.ReportFileName = App.Path & "\rptkaryawan.rpt" crpegawai.Action = 1 End Sub
Frmcuti.frm Private Sub InitConnection() Dim conDBString As String
Universitas Sumatera Utara
72 conDBString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\dbkaryawan.mdb" Set datayus = New ADODB.Connection datayus.ConnectionString = conDBString datayus.Open End Sub
Private Sub PopData(strTextSearch As String) Dim lstX As ListItem Dim strSQL As String Dim rs As ADODB.Recordset Dim intCounter As Integer If strTextSearch = "" Then strSQL = " select * from cuti order by Nama ASC" Else strSQL = " select * from cuti " & _ " where Nama like ' % " & strTextSerch & "%' order by Nama ASC " End If Set rs = New ADODB.Recordset rs.Open strSQL, datayus, 3, 1 lstView.ListItems.Clear With rs If .RecordCount > 0 Then .MoveFirst intCounter = 1 While Not .EOF Set lstX = lstView.ListItems.Add(, , intCounter) lstX.ListSubItems.Add = Trim(!Nama) lstX.ListSubItems.Add = Trim(!NRK) lstX.ListSubItems.Add = Trim(!Tgl_cuti) lstX.ListSubItems.Add = Trim(!Golongan) lstX.ListSubItems.Add = Trim(!Jabatan) lstX.ListSubItems.Add = Trim(!Hak_cuti) lstX.ListSubItems.Add = Trim(!Cuti_yang_diambil)
Universitas Sumatera Utara
lstX.ListSubItems.Add = Trim(!sisa_cuti) lstX.ListSubItems.Add = Trim(!keterangan) intCounter = intCounter + 1 .MoveNext Wend End If End With End Sub
Private Sub PopData1(strTextSearch1 As String) Dim lstX As ListItem Dim strSQL As String Dim rs As ADODB.Recordset Dim intCounter As Integer If strTextSearch1 = "" Then strSQL = " select * from karyawan order by Nama ASC" Else strSQL = " select * from karyawan " & _ " where Nama like '%" & strTextSearch1 & "%' order by Nama asc " End If Set rs = New ADODB.Recordset rs.Open strSQL, datayus, 3, 1 ListView1.ListItems.Clear With rs If .RecordCount > 0 Then .MoveFirst intCounter = 1 While Not .EOF Set lstX = ListView1.ListItems.Add(, , intCounter) lstX.ListSubItems.Add = Trim(!Nama) lstX.ListSubItems.Add = Trim(!Bagian) lstX.ListSubItems.Add = Trim(!NRK) lstX.ListSubItems.Add = Trim(!Jabatan) lstX.ListSubItems.Add = Trim(!Golongan)
Universitas Sumatera Utara
74 lstX.ListSubItems.Add = Trim(!Pendidikan) intCounter = intCounter + 1 .MoveNext Wend End If End With End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim intSelItem As Integer intSelItem = Item txtnama.Text = ListView1.ListItems(intSelItem).ListSubItems(1) txtnrk.Text = ListView1.ListItems(intSelItem).ListSubItems(3) txtgolongan.Text = ListView1.ListItems(intSelItem).ListSubItems(5) txtjabatan.Text = ListView1.ListItems(intSelItem).ListSubItems(4) End Sub
Private Sub cmdrefresh_Click() txtnrk.Text = "" txtnama.Text = "" tgl.Value = "" txthak.Text = "" txtcuti.Text = "" txtsisa.Text = "" txtketerangan.Text = "" txtjabatan.Text = "" txtgolongan.Text = "" End Sub
Private Sub cmdcancel_Click() Unload Me End Sub
Universitas Sumatera Utara
Private Sub cmdhapus_Click() Dim strDelete As String Dim MB As Byte MB = MsgBox("Anda Yakin Menghapus Data INI...?", vbYesNo + vbInformation, "Pesan") If MB = vbYes Then strDelete = "Delete from cuti Where NRK ='" & txtnrk.Text & "' " datayus.Execute strDelete PopData (strTextSearch) txtnama.Text = "" txtnrk.Text = "" tgl.Value = "" txtgolongan.Text = "" txtjabatan.Text = "" txthak.Text = "" txtcuti.Text = "" txtsisa.Text = "" txtketerangan.Text = "" End If End Sub
Private Sub cmdsimpan_Click() Dim nilai As Integer Dim strSQL As String Dim rs As ADODB.Recordset Dim koneksi As ADODB.Connection Dim cek As ADODB.Recordset Set koneksi = New ADODB.Connection Set cek = New ADODB.Recordset Dim x As Integer x=0 koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbkaryawan.mdb;Persist Security Info=False" cek.CursorLocation = adUseClient cek.Open "select * from cuti ", koneksi, adOpenKeyset
Universitas Sumatera Utara
76 Do Until cek.EOF If cek!Tgl_cuti = tgl.Value Then x=x+1 End If cek.MoveNext Loop Label9.Caption = x If Val(Label9.Caption) >= 2 Then MsgBox " Maaf Anda Sudah Tidak Bisa Mengambil Cuti lagi Untuk Hari ini ", vbExclamation, "Alert" txtnama.Text = "" txtnrk.Text = "" tgl.Value = "" txtgolongan.Text = "" txtjabatan.Text = "" txthak.Text = "" txtcuti.Text = "" txtsisa.Text = "" txtketerangan.Text = "" txtnama.SetFocus Else If txtnama.Text = "" Or txtnrk.Text = "" Or tgl.Value = "" Or txtgolongan.Text = "" Or txtjabatan.Text = "" Or txthak.Text = "" _ Or txtcuti.Text = "" Or txtsisa.Text = "" Or txtketerangan.Text = "" Then MsgBox " Masukkin Data Dengan Lengkap. ", vbExclamation, "Alert" End If strSQL = "Insert into cuti (Nama,NRK,Tgl_cuti,golongan,jabatan,Hak_cuti,cuti_yang_diambil,sisa_cuti,keterangan) values ('" & SQLSafe(txtnama.Text) & "','" & _ SQLSafe(txtnrk.Text) & "','" & SQLSafe(tgl.Value) & "','" & SQLSafe(txtgolongan.Text) & "','" & SQLSafe(txtjabatan.Text) & "','" & SQLSafe(txthak.Text) & "','" & SQLSafe(txtcuti.Text) & "','" & SQLSafe(txtsisa.Text) & "','" & SQLSafe(txtketerangan.Text) & "')" datayus.Execute strSQL
Universitas Sumatera Utara
MsgBox " Berhasil Diinput ", vbExclamation, "Alert" End If txtnama.Text = "" txtnrk.Text = "" tgl.Value = "" txtgolongan.Text = "" txtjabatan.Text = "" txthak.Text = "" txtcuti.Text = "" txtsisa.Text = "" txtketerangan.Text = "" txtnama.SetFocus PopData (strTextSearch) End Sub Private Sub Form_Load() InitConnection PopData (strTextSearch) PopData1 (strTextSearch1) End Sub
Private Sub lstView_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim intSelItem As Integer intSelItem = Item txtnama.Text = lstView.ListItems(intSelItem).ListSubItems(1) txtnrk.Text = lstView.ListItems(intSelItem).ListSubItems(2) tgl.Value = lstView.ListItems(intSelItem).ListSubItems(3) txtgolongan.Text = lstView.ListItems(intSelItem).ListSubItems(4) txtjabatan.Text = lstView.ListItems(intSelItem).ListSubItems(5) txthak.Text = lstView.ListItems(intSelItem).ListSubItems(6) txtcuti.Text = lstView.ListItems(intSelItem).ListSubItems(7) txtsisa.Text = lstView.ListItems(intSelItem).ListSubItems(8) txtketerangan.Text = lstView.ListItems(intSelItem).ListSubItems(9) End Sub
Universitas Sumatera Utara
78 Private Sub txtsearch_Change() PopData1 (txtsearch.Text) End Sub
Private Sub txtsisa_GotFocus() If Val(txtcuti.Text) <= Val(txthak.Text) Then txtsisa.Text = Val(txthak.Text) - Val(txtcuti.Text) Else MsgBox "HAK Cuti Sudah Habis" End If txtcuti.SetFocus End Sub
Frmpegawai.frm
Private Sub InitConnection() Dim conDBString As String conDBString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\dbkaryawan.mdb" Set datayus = New ADODB.Connection datayus.ConnectionString = conDBString datayus.Open End Sub
Private Sub cmdhapus_Click() Dim strDelete As String Dim MB As Byte MB = MsgBox("Anda Yakin Menghapus Data INI...?", vbYesNo + vbInformation, "Pesan") If MB = vbYes Then strDelete = "Delete from karyawan Where NRK ='" & SQLSafe(txtnrk.Text) & "'" datayus.Execute strDelete PopData1 (strTextSearch1) txtnama.Text = "" txtnrk.Text = ""
Universitas Sumatera Utara
txtjabatan.Text = "" txtbagian.Text = "" txtgolongan.Text = "" txtpendidikan.Text = "" End If End Sub
Private Sub cmdrefresh_Click() txtnrk.Text = "" txtbagian.Text = "" txtnama.Text = "" txtjabatan.Text = "" txtgolongan.Text = "" txtpendidikan.Text = "" End Sub
Private Sub cmdkeluar_Click() Unload Me End Sub
Private Sub cmdsimpan_Click() Dim strSQL As String Dim rs As ADODB.Recordset If txtnama.Text = "" Or txtnrk.Text = "" Or txtbagian.Text = "" Or txtgolongan.Text = "" Or txtpendidikan.Text = "" Then MsgBox " Masukkin Data Dengan Lengkap. ", vbExclamation, "Alert" Exit Sub End If strSQL = "Insert into karyawan (Nama,Bagian,NRK,Jabatan,Golongan,Pendidikan) values ('" & SQLSafe(txtnama.Text) & "','" & _ SQLSafe(txtnrk.Text) & "','" & SQLSafe(txtgolongan.Text) & "','" & SQLSafe(txtjabatan.Text) & "','" & SQLSafe(txtbagian.Text) & "','" & SQLSafe(txtpendidikan.Text) & "')" datayus.Execute strSQL
Universitas Sumatera Utara
80 PopData1 (strSearch1) txtnama.Text = "" txtnrk.Text = "" txtjabatan.Text = "" txtbagian.Text = "" txtgolongan.Text = "" txtpendidikan.Text = "" End Sub
Private Sub cmdedit_click() Dim strUpdate As String strUpdate = "Update karyawan Set Nama ='" & SQLSafe(txtnama.Text) & "',NRK ='" & SQLSafe(txtnrk.Text) & "',Golongan='" & SQLSafe(txtgolongan.Text) & "',Jabatan ='" & SQLSafe(txtjabatan.Text) & "',Bagian ='" & SQLSafe(txtbagian.Text) & "',Pendidikan='" & SQLSafe(txtpendidikan.Text) & "' Where NRK ='" & SQLSafe(txtnrk.Text) & "'" datayus.Execute strUpdate PopData1 (strTextSearch1) txtnama.Text = "" txtnrk.Text = "" txtjabatan.Text = "" txtbagian.Text = "" txtgolongan.Text = "" txtpendidikan.Text = "" End Sub
Private Sub Form_Load() InitConnection PopData1 (strTextSearch1) End Sub
Private Sub PopData1(strTextSearch1 As String) Dim lstX As ListItem Dim strSQL As String Dim rs As ADODB.Recordset
Universitas Sumatera Utara
Dim intCounter As Integer If strTextSearch1 = "" Then strSQL = " select * from karyawan order by Nama ASC" Else strSQL = " select * from karyawan " & _ " where Nama like '%" & strTextSearch1 & "%' order by Nama asc " End If Set rs = New ADODB.Recordset rs.Open strSQL, datayus, 3, 1 ListView1.ListItems.Clear With rs If .RecordCount > 0 Then .MoveFirst intCounter = 1 While Not .EOF Set lstX = ListView1.ListItems.Add(, , intCounter) lstX.ListSubItems.Add = Trim(!Nama) lstX.ListSubItems.Add = Trim(!Bagian) lstX.ListSubItems.Add = Trim(!NRK) lstX.ListSubItems.Add = Trim(!Jabatan) lstX.ListSubItems.Add = Trim(!Golongan) lstX.ListSubItems.Add = Trim(!Pendidikan) intCounter = intCounter + 1 .MoveNext Wend End If End With End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem) txtnrk.Enabled = False Dim intSelItem As Integer intSelItem = Item txtnama.Text = ListView1.ListItems(intSelItem).ListSubItems(1)
Universitas Sumatera Utara
82 txtbagian.Text = ListView1.ListItems(intSelItem).ListSubItems(2) txtnrk.Text = ListView1.ListItems(intSelItem).ListSubItems(3) txtgolongan.Text = ListView1.ListItems(intSelItem).ListSubItems(5) txtjabatan.Text = ListView1.ListItems(intSelItem).ListSubItems(4) txtpendidikan.Text = ListView1.ListItems(intSelItem).ListSubItems(6) End Sub Frmspalsh.frm Option Explicit Private Sub Form_KeyPress(KeyAscii As Integer) Unload Me End Sub
Private Sub Timer1_Timer() bar.Value = bar.Value + 4 Screen.MousePointer = vbHourglass If bar.Value = 8 Then lblbar.Caption = "Loading . . ." ElseIf bar.Value = 28 Then lblbar.Caption = "Waiting database . . ." ElseIf bar.Value = 40 Then lblbar.Caption = "Initializing . . ." ElseIf bar.Value = 68 Then lblbar.Caption = "Please wait . . ." ElseIf bar.Value = 100 Then If bar.Value = 100 Then If Timer1.Interval >= 1 Then Unload Me Screen.MousePointer = vbDefault frmmenu.Show End If End If End If End Sub Module.bas
Universitas Sumatera Utara
Public datayus As ADODB.Connection Public Function SQLSafe(strValue As String) As String Dim strTemp1 As String strTemp1 = Replace(strValue, "'", "''") SQLSafe = strTemp1 End Function
Universitas Sumatera Utara
