Team The Power Of IT : Terima Kasih Atas Kunjungan Anda Silahkan Ambil Informasi yang dianggap Anda Penting dan Beritahu kami bila ada sesuatu yang kurang lengkap atau tidak menarik atau kurang Memuaskan (*_*)

Cari

Wednesday, November 1, 2017

APLIKASI PENGGAJIAN DENGAN VISUAL BASIC 6.0


FORM SPLASH

Private Sub Timer1_Timer()
Load Form4
Unload Me
Form4.Show
End Sub



FORM LOGGIN

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdlogin_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Bersih Me
End Sub




Private Sub Timer1_Timer()
ProgressBar1.Value = ProgressBar1.Value + 10

If ProgressBar1.Value = 100 Then
If ProgressBar1.Value >= ProgressBar1.Max Then
If txtuser = "AKU" And txtpwd = "AKU" Then
    Unload Me
    MDIForm1.Show
    Else
    MsgBox "User Tidak Valid", vbCritical
    txtuser = ""
    txtpwd = ""
    txtuser.SetFocus
End If
Timer1.Enabled = False
ProgressBar1.Value = 0
End If
End If
End Sub



MDI FORM
 
Private Sub Datajab_Click()
Form1.Show
End Sub

Private Sub Datapeg_Click()
Form2.Show
End Sub

Private Sub Datapeng_Click()
Form3.Show
End Sub

Private Sub Datjab_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\ariez.rpt"
crpt.Destination = crptToWindow
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub

Private Sub Datpeg_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\adwi.rpt"
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub

Private Sub Datpeng_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\arifah.rpt"
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub

Private Sub kel_Click()
Unload Me
End Sub

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub tenprog_Click()
ShellAbout 0, "PT.ARIFAH INDONESIA", "Penggajian Management System V1.0" & vbCrLf & "by : AriezdwiRPL", Icon
End Sub



FORM JABATAN
 
Dim db As ADODB.Connection
Dim rsjabatan As ADODB.Recordset
Private Sub cmdbaru_Click()
kdjab_OTOMATIS
txtnmjab.SetFocus
End Sub
Private Sub cmdbatal_Click()
Bersih Me
End Sub
Private Sub cmdhapus_Click()
'hapus data
Pesan = InputBox("Masukan Kode Jabatan")
If Pesan <> "" Then
Dim conf
conf = MsgBox("Anda Yakin Akan Menghapus Data??", vbQuestion + vbYesNo)
If conf + vbYes Then
db.Execute "delete*from jabatan where kdjab ='" & Pesan & "'"
MsgBox ("Data Telah Dihapus")
End If
End If

End Sub
Private Sub cmdlaporan_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\ariez.rpt"
crpt.Destination = crptToWindow
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub

Private Sub cmdsearch_Click()
Dim conf As String
conf = InputBox("Kode jabatan yang dicari :")
If Trim(conf) <> "" Then
    Set rsjabatan = New ADODB.Recordset
    rsjabatan.Open "jabatan", db, 3, 2
    Set rsjabatan = db.Execute("SELECT * from jabatan where kdjab='" & conf & "'")
    If rsjabatan.EOF Then
    MsgBox "Data tidak terdaftar"
    Else
        txtkdjab = rsjabatan.Fields(0)
        txtnmjab = rsjabatan.Fields(1)
        txtgapok = rsjabatan.Fields(2)
        txttunjab = rsjabatan.Fields(3)
        End If
    End If
End Sub

Private Sub cmdsimpan_Click()
Dim conf
conf = MsgBox("Simpan Data Jabatan.??", vbQuestion + vbYesNo)
If conf = vbYes Then
db.Execute "Insert into Jabatan Values('" & txtkdjab & "','" & txtnmjab & "','" & txtgapok & "','" & txttunjab & "')"
End If
Bersih Me
End Sub

Private Sub Form_Load()
'koneksi data base
Set db = New ADODB.Connection
db.Open "PROVIDER=Microsoft.JET.OLEDB.4.0;Data Source=" & App.Path & "\jabatan.mdb"

'koneksi tabel
Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "SELECT*FROM jabatan Order By kdjab", db, 3, 2
End Sub
Public Sub kdjab_OTOMATIS()
Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "Jabatan", db, 3, 2

If rsjabatan.RecordCount = 0 Then
    txtkdjab = "001"
Else
    rsjabatan.MoveLast
        txtkdjab = Trim(Str(Val(Right(rsjabatan.Fields(0), 3)) + 1))
        txtkdjab = Left("003", 3 - Len(txtkdjab)) + txtkdjab
End If
End Sub

Private Sub cmdkeluar_Click()
Unload Me
End Sub



FORM PEGAWAI
 
Dim db As ADODB.Connection
Dim rsjabatan As ADODB.Recordset
Dim rspegawai As ADODB.Recordset

Private Sub cmdsearch_Click()
Dim conf As String
conf = InputBox("Kode Pegawai yang dicari :")
If Trim(conf) <> "" Then
    Set rspegawai = New ADODB.Recordset
    rspegawai.Open "pegawai", db, 3, 2
    Set rspegawai = db.Execute("SELECT * from pegawai where kdpeg='" & conf & "'")
    If rspegawai.EOF Then
    MsgBox "Data tidak terdaftar"
    Else
        txtkdpeg = rspegawai.Fields(0)
        txtnmpeg = rspegawai.Fields(1)
        txtalmt = rspegawai.Fields(2)
        txttgllhr = rspegawai.Fields(3)
        txtjk = rspegawai.Fields(4)
        cmbkdjab = rspegawai.Fields(5)
        txtjab = rspegawai.Fields(6)
        End If
    End If
End Sub

Private Sub Form_Load()
'konkesi database
Set db = New ADODB.Connection
db.Open "PROVIDER=Microsoft.JET.OLEDB.4.0;Data Source=" & App.Path & "\jabatan.mdb"
'koneksi tabel
Set rspegawai = New ADODB.Recordset
rspegawai.Open "SELECT * FROM pegawai Order By kdpeg", db, 3, 2
'koneksi tabel
Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "SELECT* FROM jabatan Order By kdjab", db, 3, 2

If rsjabatan.RecordCount <> 0 Then
rsjabatan.MoveFirst
For i = 1 To rsjabatan.RecordCount
cmbkdjab.AddItem rsjabatan.Fields(0)
rsjabatan.MoveNext
Next i
End If
Bersih Me
End Sub
Private Sub cmbkdjab_Click()
'koneksi tabel
Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "SELECT * FROM jabatan Order By kdjab", db, 3, 2
Set rsjabatan = db.Execute("select * from jabatan where kdjab='" & cmbkdjab & "'")
If rsjabatan.EOF = False Then
txtjab = rsjabatan.Fields(1)
End If
cmdsimpan.SetFocus
End Sub

Private Sub cmdbaru_Click()
kdpeg_OTOMATIS
txtnmpeg.SetFocus
End Sub

Private Sub cmdbatal_Click()
Bersih Me
txtkdpeg.SetFocus
End Sub
 


Private Sub cmdhapus_Click()
'hapus data
Pesan = InputBox("Masukan Kode Pegawai")
If Pesan <> "" Then
Dim conf
conf = MsgBox("Anda Yakin Akan Menghapus Data ?", vbQuestion + vbYesNo)
If conf = vbYes Then
db.Execute "delete * from pegawai where kdpeg = '" & Pesan & "'"
MsgBox ("Data Telah Dihapus")
End If
End If
End Sub

Private Sub cmdkeluar_Click()
Unload Me
End Sub

Private Sub cmdlaporan_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\adwi.rpt"
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub
Private Sub cmdsimpan_Click()
Dim conf
conf = MsgBox("Simpan Data Pegawai?", vbQuestion + vbYesNo)
If conf = vbYes Then
'simpan data
db.Execute "Insert into pegawai values('" & txtkdpeg & "','" & txtnmpeg & "','" & txtalmt & "','" & txttgllhr & "','" & txtjk & "','" & cmbkdjab & "','" & txtjab & "')"
End If
Bersih Me
txtkdpeg.SetFocus
End Sub

Public Sub kdpeg_OTOMATIS()
Set rspegawai = New ADODB.Recordset
rspegawai.Open "Pegawai", db, 3, 2

If rspegawai.RecordCount = 0 Then
    txtkdpeg = "001"
Else
    rspegawai.MoveLast
        txtkdpeg = Trim(Str(Val(Right(rspegawai.Fields(0), 3)) + 1))
        txtkdpeg = Left("003", 3 - Len(txtkdpeg)) + txtkdpeg
End If
End Sub



FORM PENGGAJIAN

Dim db As ADODB.Connection
Dim rsjabatan As ADODB.Recordset
Dim rspegawai As ADODB.Recordset
Dim rsgaji As ADODB.Recordset

Private Sub cmbkdpeg_Click()
Dim kdjab As String
Set rspegawai = New ADODB.Recordset
rspegawai.Open "pegawai", db, 3, 2
Set rspegawai = db.Execute("SELECT*FROM pegawai where kdpeg='" & cmbkdpeg & "'")
If rspegawai.EOF = False Then
 txtnmpeg = rspegawai.Fields(1)
 kdjab = rspegawai.Fields(5)
 txtjab = rspegawai.Fields(6)
 Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "jabatan", db, 3, 2
Set rsjabatan = db.Execute("SELECT*FROM jabatan where kdjab ='" & kdjab & "'")
If rsjabatan.EOF = False Then
 txtgapok = rsjabatan.Fields(2)
 txttunj = rsjabatan.Fields(3)
 txtpinj.SetFocus
End If
End If
End Sub

Private Sub cmdbaru_Click()
Bersih Me
Label10 = ""
NOfaktur_OTOMATIS
cmbkdpeg.SetFocus
 txttgl = Format(Date, "DD/MM/YYYY")
 txtperiode = Format(Date, "MMMM")
End Sub

Private Sub cmdbatal_Click()
Bersih Me
cmdbaru.SetFocus
Label10 = ""
End Sub

Private Sub cmdhapus_Click()
'hapus data
Pesan = InputBox("Masukan Nofactur")
If Pesan <> "" Then
Dim conf
conf = MsgBox("Anda Yakin Akan Menghapus Data ?", vbQuestion + vbYesNo)
If conf = vbYes Then
db.Execute "delete * from penggajian where nofactur = '" & Pesan & "'"
MsgBox ("Data Telah Dihapus")
End If
End If

End Sub

Private Sub cmdkeluar_Click()
Unload Me
End Sub

Private Sub cmdlaporan_Click()
crpt.DataFiles(0) = App.Path & "\jabatan.mdb"
crpt.ReportFileName = App.Path & "\arifah.rpt"
crpt.WindowState = crptMaximized
crpt.Action = 1
End Sub

Private Sub cmdsearch_Click()
Dim conf As String
conf = InputBox("nofactur yang dicari :")
If Trim(conf) <> "" Then
    Set rspenggajian = New ADODB.Recordset
    rspenggajian.Open "penggajian", db, 3, 2
    Set rspenggajian = db.Execute("SELECT * from penggajian where nofactur='" & conf & "'")
    If rspenggajian.EOF Then
    MsgBox "Data tidak terdaftar"
    Else
        txtnofactur = rspenggajian.Fields(0)
        txttgl = rspenggajian.Fields(1)
        txtperiode = rspenggajian.Fields(2)
        cmbkdpeg = rspenggajian.Fields(3)
        txtnmpeg = rspenggajian.Fields(4)
        txtjab = rspenggajian.Fields(5)
        txttunj = rspenggajian.Fields(8)
        txtpinj = rspenggajian.Fields(11)
        txtinfak = rspenggajian.Fields(10)
        txtpotlain = rspenggajian.Fields(9)
        txttotgaji = rspenggajian.Fields(6)
        txtgapok = rspenggajian.Fields(7)
        End If
    End If
End Sub

Private Sub cmdsimpan_Click()
Dim conf
conf = MsgBox("Simpan Data Penggajian?", vbQuestion + vbYesNo)
If conf = vbYes Then
'simpan data
db.Execute "Insert into penggajian values('" & txtnofactur & "','" & txttgl & "','" & txtperiode & "','" & cmbkdpeg & "','" & txtnmpeg & "','" & txtjab & "','" & txttotgaji & "','" & txtgapok & "','" & txttunj & "','" & txtpinj & "','" & txtinfak & "','" & txtpotlain & "')"
End If
Bersih Me
Label10 = ""
txtnofactur.SetFocus
End Sub

Private Sub Form_Load()
'konkesi database
Set db = New ADODB.Connection
db.Open "PROVIDER=Microsoft.JET.OLEDB.4.0;Data Source=" & App.Path & "\jabatan.mdb"
'koneksi tabel
Set rspegawai = New ADODB.Recordset
rspegawai.Open "SELECT * FROM pegawai Order By kdpeg", db, 3, 2
'koneksi tabel
Set rsjabatan = New ADODB.Recordset
rsjabatan.Open "SELECT* FROM jabatan Order By kdjab", db, 3, 2

If rspegawai.RecordCount <> 0 Then
rspegawai.MoveFirst
For i = 1 To rspegawai.RecordCount
cmbkdpeg.AddItem rspegawai.Fields(0)
rspegawai.MoveNext
Next i
End If
End Sub

Private Sub Timer1_Timer()
Label11 = Time$
End Sub

Private Sub Timer2_Timer()
Label12 = Format$(Now, "ddd,dd mmmm yyyy")
End Sub

Private Sub txtpotlain_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If txtpotlain = "" Then
txtpotlain.SetFocus
Else
'Jumlah Gaji
txttotgaji = (Val(txtgapok) + (txttunj)) - (Val(txtpinj) + (txtinfak) + (txtpotlain))
Label10.Caption = Terbilang(txttotgaji)
cmdsimpan.SetFocus
End If
End If
End Sub

Public Sub NOfaktur_OTOMATIS()
Set rsgaji = New ADODB.Recordset
rsgaji.Open "penggajian", db, 3, 2
If rsgaji.RecordCount = 0 Then
txtnofactur = Format(Date, "yymm") + "/PG/001"
Else
rsgaji.MoveLast
If Left(rsgaji.Fields(0), 4) = Format(Date, "yymm") Then
 txtnofactur = Trim(Str(Val(Right(rsgaji.Fields(0), 3)) + 1))
 txtnofactur = Format(Date, "yymm") + "/PG/" + Left("000", 3 - Len(txtnofactur)) + txtnofactur
Else
 txtnofactur = Format(Date, "yymm") + "/PG/001"
 End If
End If
End Sub



MODULE PENGGAJIAN

Public Declare Function ShellAbout Lib "Shell32.dll" Alias _
"ShellAboutA" (ByVal Hwnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal Hicon As Long) As Long
Public Sub Bersih(Frm As Form)
For Each Obj In Frm
 If TypeOf Obj Is TextBox Then
 Obj.Text = ""
 ElseIf TypeOf Obj Is ComboBox Then
 Obj.Text = ""
 ElseIf TypeOf Obj Is ListBox Then
 Obj.Clear = ""

 End If
 Next Obj
End Sub
Public Function Terbilang(X As Currency)
Dim Triliun As Currency
Dim Milyar As Currency
Dim Juta As Currency
Dim Ribu As Currency
Dim Satu As Currency
Dim Sen As Currency
Dim baca As String
If X = 0 Then
baca = angka(0, 1)
Else
Triliun = Int(X * 0.001 ^ 4)
Milyar = Int((X - Triliun * 1000 ^ 4) * 0.0001 ^ 3)
Juta = Int((X - Triliun * 1000 ^ 4 - Milyar * 1000 ^ 3) / 1000 ^ 2)
Ribu = Int((X - Triliun * 1000 ^ 4 - Milyar * 1000 ^ 3 - Juta * 1000 ^ 2) / 1000)
Satu = Int(X - Triliun * 1000 ^ 4 - Milyar * 1000 ^ 3 - Juta * 1000 ^ 2 - Ribu * 1000)
Sen = Int((X - Int(X)) * 100)

If Triliun > 0 Then
baca = ratus(Triliun, 5) + " triliun "
End If

If Milyar > 0 Then
baca = ratus(Milyar, 4) + " milyar "
End If

If Juta > 0 Then
baca = baca + ratus(Juta, 3) + " juta "
End If

If Ribu > 0 Then
baca = baca + ratus(Ribu, 2) + " ribu "

baca = baca + ratus(Satu, 1) + " rupiah "
End If

If Sen > 0 Then
baca = baca + ratus(Sen, 0) + " sen "
End If
End If
Terbilang = (Left(baca, 1)) & (Mid(baca, 2))
End Function
Function ratus(X As Currency, posisi As Integer) As String
Dim a100 As Integer, a10 As Integer, a1 As Integer
Dim baca As String
a100 = Int(X * 0.01)
a10 = Int((X - a100 * 100) * 0.1)
a1 = Int(X - a100 * 100 - a10 * 10)
If a100 = 1 Then
baca = "seratus"
Else
If a100 > 0 Then
baca = angka(a100, 2) + " ratus "
End If
End If
If a10 = 1 Then
baca = baca + angka(a10 * 10 + a1, 2)
Else
If a10 > 0 Then
baca = baca + angka(a10, 2) + " puluh "
End If
If a1 > 0 Then
If posisi = 2 And a100 = 0 And a10 = 0 Then
baca = baca + angka(a1, 1)
Else
baca = baca + angka(a1, 2)
End If
End If
End If
ratus = baca
End Function
Function angka(X As Integer, posisi As Integer)
Select Case X
Case 0: angka = "nol"
Case 1:
If posisi = 2 Then
angka = "satu"
Else
angka = "se"
End If
Case 2:   angka = "dua"
Case 3:   angka = "tiga"
Case 4:   angka = "empat"
Case 5:   angka = "lima"
Case 6:   angka = "enam"
Case 7:   angka = "tujuh"
Case 8:   angka = "delapan"
Case 9:   angka = "sembilan"
Case 10:   angka = "sepuluh"
Case 11:   angka = "sebelas"
Case 12:   angka = "duabelas"
Case 13:   angka = "tigabelas"
Case 14:   angka = "empatbelas"
Case 15:   angka = "limabelas"
Case 16:   angka = "enambelas"
Case 17:   angka = "tujuhbelas"
Case 18:   angka = "delapanbelas"
Case 19:   angka = "sembilanbelas"
End Select
End Function


CARA MEMBUAT FILE .EXE
  1. BUKA FILE VB NYA
  2. PASTIKAN CODING TIDAK ADA YANG DEBUG
  3. PILIH FILE
  4. PILIH MAKE PENGGAJIAN.EXE/PROJECT.EXE
  5. ARAHKAN MAU DISIMPAN DIMAN, LALU KLIK OKE.
URUTAN SET FORM :
  1. SPLASH
  2. LOGGIN
  3. MDI FORM
  4. JABATAN
  5. PEGAWAI
  6. PENGGAJIAN
CARA MERUBAH START UP :
  1. KLIK KANAN DI PROJECT
  2. PILIH PROJECT PRIPERTIES
  3. PILIH STAR UP OBJECT LALU PILIH FORM YANG AKAN BERJALAN PERTAMA KALI DIJALANKAN.
  4. KLIK OKE




Design SatriaDholan at 12:26 PM

No comments:

Post a Comment

design by The Power Of IT

Subscribe to: Post Comments (Atom)