Setelah kita melihat Contoh Program aplikasi penggajian PT HOYAMA memakai visual basic 6.0, selanjutnya kita lihat form penghitungan bonus.
Pada kasus ini penghitugan bonus karyawan hanya dipakai satu tahun sekali saja yakni pada simpulan tahun (bulan desember), rata-rata perusahaan besar memperlihatkan kesejahteraan berupa Bonus Akhir tahun. Pada umumnya bonus yaitu honor pokok dikalikan jumlah kali lipatnya, untuk karyawan bebeda-beda pendapatannya, contohnya untuk karyawan yang sudah menetap mendapat 5 kali lipat dan untuk karyawan dalam masa kontrak hanya satu kali honor pokok saja.
Silahkan anda menciptakan form dibawah ini dengan name=formhitungbonus ;
Catatan ;A. Buat tabel grid
B. Masukkan komponen timer dan crystal rport
C. untuk textbox dengan name tnamab,tgapok, kodeuser dan tmasakerja pada propertiesnya visible=false
1. Buat sub gres dengan nama sub aktif dan pastekan koding dibawah ini ;
tidcounter.Enabled = True
tidkaryawan.Enabled = True
tnamakaryawan.Enabled = True
tjenisk.Enabled = True
ttglmsk.Enabled = True
tdivisi.Enabled = True
tdepartemen.Enabled = True
tjabatan.Enabled = True
tstatus.Enabled = True
tkodebonus.Enabled = True
cgolongan.Enabled = True
tjklipat.Enabled = True
tbonus.Enabled = True
bditerima.Enabled = True
ctambah.Enabled = True
csimpan.Enabled = True
cbatal.Enabled = True
tidkaryawan.Enabled = True
tnamakaryawan.Enabled = True
tjenisk.Enabled = True
ttglmsk.Enabled = True
tdivisi.Enabled = True
tdepartemen.Enabled = True
tjabatan.Enabled = True
tstatus.Enabled = True
tkodebonus.Enabled = True
cgolongan.Enabled = True
tjklipat.Enabled = True
tbonus.Enabled = True
bditerima.Enabled = True
ctambah.Enabled = True
csimpan.Enabled = True
cbatal.Enabled = True
2. Buat sub gres dengan nama sub nonaktif dan pastekan koding dibawah ini ;
tidcounter.Enabled = False
tidkaryawan.Enabled = False
tnamakaryawan.Enabled = False
tjenisk.Enabled = False
ttglmsk.Enabled = False
tdivisi.Enabled = False
tdepartemen.Enabled = False
tjabatan.Enabled = False
tstatus.Enabled = False
tkodebonus.Enabled = False
tgolongan.Enabled = False
tjklipat.Enabled = False
tbonus.Enabled = False
bditerima.Enabled = False
ctambah.Enabled = False
csimpan.Enabled = False
cbatal.Enabled = False
tidkaryawan.Enabled = False
tnamakaryawan.Enabled = False
tjenisk.Enabled = False
ttglmsk.Enabled = False
tdivisi.Enabled = False
tdepartemen.Enabled = False
tjabatan.Enabled = False
tstatus.Enabled = False
tkodebonus.Enabled = False
tgolongan.Enabled = False
tjklipat.Enabled = False
tbonus.Enabled = False
bditerima.Enabled = False
ctambah.Enabled = False
csimpan.Enabled = False
cbatal.Enabled = False
3. Buat sub gres dengan nama sub higienis dan pastekan koding dibawah ini ;
tidcounter.Text = ""
tidkaryawan.Text = ""
tnamakaryawan.Text = ""
tjenisk.Text = ""
ttglmsk.Text = ""
tdivisi.Text = ""
tdepartemen.Text = ""
tjabatan.Text = ""
tstatus.Text = ""
tkodebonus.Text = ""
tgolongan.Text = ""
tjklipat.Text = ""
tbonus.Text = ""
bditerima.Text = ""
tidkaryawan.Text = ""
tnamakaryawan.Text = ""
tjenisk.Text = ""
ttglmsk.Text = ""
tdivisi.Text = ""
tdepartemen.Text = ""
tjabatan.Text = ""
tstatus.Text = ""
tkodebonus.Text = ""
tgolongan.Text = ""
tjklipat.Text = ""
tbonus.Text = ""
bditerima.Text = ""
4. Buat sub gres dengan nama sub tampil dan pastekan koding dibawah ini ;
Call koneksi
rsdatabonus.Open "select*from tabelhitungbonus", KON
Set grid1.DataSource = rsdatabonus
rsdatabonus.Open "select*from tabelhitungbonus", KON
Set grid1.DataSource = rsdatabonus
5. Buat sub gres dengan nama sub kodebonus dan pastekan koding dibawah ini ;
Call koneksi
rsdatabonus.Open "select*from tabelbonus where golongan='" & tgolongan.Text & "' and namabonus='" & tnamab & "'", KON
If rsdatabonus.EOF Then
MsgBox "Maaf Data Bonus Tidak tersedia, Mohon Isi dahulu !", vbInformation
Call bersih
Call Form_Load
Call nonaktif
ctambah.Enabled = True
Else
tkodebonus.Text = rsdatabonus.Fields("kodebonus")
tjklipat.Text = rsdatabonus.Fields("kalilipat")
tbonus.Text = Val(tgapok.Text) * Val(tjklipat.Text)
bditerima.Text = tbonus.Text
Call nonaktif
csimpan.Enabled = True
cbatal.Enabled = True
End If
rsdatabonus.Open "select*from tabelbonus where golongan='" & tgolongan.Text & "' and namabonus='" & tnamab & "'", KON
If rsdatabonus.EOF Then
MsgBox "Maaf Data Bonus Tidak tersedia, Mohon Isi dahulu !", vbInformation
Call bersih
Call Form_Load
Call nonaktif
ctambah.Enabled = True
Else
tkodebonus.Text = rsdatabonus.Fields("kodebonus")
tjklipat.Text = rsdatabonus.Fields("kalilipat")
tbonus.Text = Val(tgapok.Text) * Val(tjklipat.Text)
bditerima.Text = tbonus.Text
Call nonaktif
csimpan.Enabled = True
cbatal.Enabled = True
End If
6. pastekan koding dibawah ini ;
Private Sub Form_Load()
Me.Width = 15150
Me.Height = 7365
Call koneksi
tnamab.Text = "Bonus Akhir Tahun"
kodeuser.Text = fmenu.StatusBar.Panels(2)
End Sub
Me.Width = 15150
Me.Height = 7365
Call koneksi
tnamab.Text = "Bonus Akhir Tahun"
kodeuser.Text = fmenu.StatusBar.Panels(2)
End Sub
7. Double klik pada ctambah dan pastekan koding dibawah ini (declaration=click);
Call koneksi
Call bersih
tidkaryawan.Enabled = True
rshitungbonus.Open "select*from tabelhitungbonus order by idcounterb desc", KON
With rshitungbonus
If .BOF And .EOF Then
tidcounter.Text = "SB" + Format(Date, "YYMM") + "0001"
Else
tidcounter.Text = "SB" + Format(Date, "YYMM") + Right(Str(Val(Right(.Fields("idcounterb"), 4)) + 10001), 4)
End If
End With
tidkaryawan.SetFocus
tidcounter.Enabled = False
ctambah.Enabled = False
cbatal.Enabled = True
tidcounter.Enabled = False
Call tampil
Call bersih
tidkaryawan.Enabled = True
rshitungbonus.Open "select*from tabelhitungbonus order by idcounterb desc", KON
With rshitungbonus
If .BOF And .EOF Then
tidcounter.Text = "SB" + Format(Date, "YYMM") + "0001"
Else
tidcounter.Text = "SB" + Format(Date, "YYMM") + Right(Str(Val(Right(.Fields("idcounterb"), 4)) + 10001), 4)
End If
End With
tidkaryawan.SetFocus
tidcounter.Enabled = False
ctambah.Enabled = False
cbatal.Enabled = True
tidcounter.Enabled = False
Call tampil
8. Double klik pada csimpan dan pastekan koding dibawah ini (declaration=click);
Call koneksi
rshitungbonus.Open "insert into tabelhitungbonus values('" & tidcounter & "','" & tidkaryawan & "','" & tnamakaryawan & "','" & tjenisk & "','" & ttglmsk & "','" & tdivisi & "','" & tdepartemen & "','" & tjabatan & "','" & tstatus & "','" & tkodebonus & "','" & tgolongan & "','" & tjklipat & "','" & tbonus & "','" & bditerima & "','" & kodeuser & "','" & tgl & "')", KON
MsgBox "Data Sudah Tersimpan", vbInformation
cr.SelectionFormula = "Totext({tabelhitungbonus.idcounterb})= '" & tidcounter.Text & "'"
cr.ReportFileName = "D:\Belajar MVB\slipbonuskaryawan.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
Call tampil
Call bersih
Call nonaktif
ctambah.Enabled = True
rshitungbonus.Open "insert into tabelhitungbonus values('" & tidcounter & "','" & tidkaryawan & "','" & tnamakaryawan & "','" & tjenisk & "','" & ttglmsk & "','" & tdivisi & "','" & tdepartemen & "','" & tjabatan & "','" & tstatus & "','" & tkodebonus & "','" & tgolongan & "','" & tjklipat & "','" & tbonus & "','" & bditerima & "','" & kodeuser & "','" & tgl & "')", KON
MsgBox "Data Sudah Tersimpan", vbInformation
cr.SelectionFormula = "Totext({tabelhitungbonus.idcounterb})= '" & tidcounter.Text & "'"
cr.ReportFileName = "D:\Belajar MVB\slipbonuskaryawan.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
Call tampil
Call bersih
Call nonaktif
ctambah.Enabled = True
9. Double klik pada cbatal dan pastekan koding dibawah ini (declaration=click);
Call bersih
Call nonaktif
ctambah.Enabled = True
Call nonaktif
ctambah.Enabled = True
10. Double klik pada tidkaryawan dan pastekan koding dibawah ini (declaration=keypress);
If KeyAscii = 13 Then
Call koneksi
rsdatakaryawan.Open "select*from tabelkaryawan where idkaryawan='" & tidkaryawan.Text & "'", KON
With rsdatakaryawan
If rsdatakaryawan.EOF Then
MsgBox "ID tidak ditemukan", vbCritical
tidkaryawan.Text = ""
Else
tidkaryawan = UCase(tidkaryawan)
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
tjenisk.Text = rsdatakaryawan.Fields("jeniskelamin")
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
ttglmsk.Text = rsdatakaryawan.Fields("tglmasuk")
tstatus.Text = rsdatakaryawan.Fields("status")
tdivisi.Text = rsdatakaryawan.Fields("divisi")
tdepartemen.Text = rsdatakaryawan.Fields("departemen")
tjabatan.Text = rsdatakaryawan.Fields("jabatan")
tgolongan.Text = rsdatakaryawan.Fields("golongan")
tgapok.Text = rsdatakaryawan.Fields("gajipokok")
End If
End With
Call kodebonus
End If
Call koneksi
rsdatakaryawan.Open "select*from tabelkaryawan where idkaryawan='" & tidkaryawan.Text & "'", KON
With rsdatakaryawan
If rsdatakaryawan.EOF Then
MsgBox "ID tidak ditemukan", vbCritical
tidkaryawan.Text = ""
Else
tidkaryawan = UCase(tidkaryawan)
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
tjenisk.Text = rsdatakaryawan.Fields("jeniskelamin")
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
ttglmsk.Text = rsdatakaryawan.Fields("tglmasuk")
tstatus.Text = rsdatakaryawan.Fields("status")
tdivisi.Text = rsdatakaryawan.Fields("divisi")
tdepartemen.Text = rsdatakaryawan.Fields("departemen")
tjabatan.Text = rsdatakaryawan.Fields("jabatan")
tgolongan.Text = rsdatakaryawan.Fields("golongan")
tgapok.Text = rsdatakaryawan.Fields("gajipokok")
End If
End With
Call kodebonus
End If
11. Double klik pada ccetak dan pastekan koding dibawah ini (declaration=click);
cr.ReportFileName = "D:\Belajar MVB\datadasar.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
12. Double klik pada timer dan pastekan koding dibawah ini ;
tjam.Text = Time
tgl.Text = Format(Date, "yyyy-mm-dd")
tgl.Text = Format(Date, "yyyy-mm-dd")
Sumber http://www.hendrisetiawan.com