Tutorial Aplikasi Penggajian Visual Basic 6.0

INSTALASI SOFTWARE

1. Klik Setup untuk menginstal aplikasi VB 6.0

2.Setelah run program munculah tampilan seperti ini .kalau mau baca readme-nya,kalau tidak silakan Next

3.Setelah Next ada Licence Agreement. Centang dulu I Accept Licence Agreement lalu Next

4. Masukan CD-key nya ke dalam ID Number seperti gambar dibawah dan isi 2 kolom  dibawahnya bebas, lalu Next lagi

5. Setelah di klik next akan tampil tampilan seperti gambar seperti ini. Pilih Install Visual Basic 6.0 .

6. Akan tampil gambar seperti ini. Next lagi

7. Selanjutnya akan muncul gambar dibawah ini. Pilih Continue

8. Pilih OK

10. Setelah itu akan tampil Gambar 16 dan Pastikan Folder sudah benar lalu Pilih yang Typical ya

11. setelah itu akan muncul kotak dialog seperti dibawah ini lalu pilih Yes

12. Dan sekarang VB 6 akan melakukan instalasi untuk menyelesaikan semua komponen.

13. Setelah instalasi selesai semua VB 6 akan meminta untuk Restart Windows. Pilih Restart Windows. Dan ingat Sebelum Restart Pastikan Dokument atau aplikasi semuanya di tutup agar aman.

Database

1. Buka Microsoft Ofice Access. Pilih Blank Database lalu  Buatlah nama database yg anda inginkan

2. Buatlah Field Tabel Jabatan Seperti dibawah ini dan beri nama = Jabatan

3. Buatlah Field Tabel Detail Penggajian dengan format seperti dibawah ini dan beri nama Tabelnya = Detail_Penggajian

4. Buatlah Tabel Pengguna dengan format seperti dibawah ini dan beri nama =  Pengguna

6. Buatlah Tabel Pegawai dengan format seperti dibawah ini dan beri nama = Pegawai

Project Penggajian

1. Buka aplikasi Microsoft Visul Basic 6.0 yang tadi telah di instal

2. Pilih VB Enterprise Edition Controls Lalu Next

lalu akn muncul Form kosong seperti dibawah ini

3. Ubah nama form pada properties (sebelah kanan) di kolom (name)

4. Buat form tersebut dengan tampilan seperti ini (gambar bebas)

lalu masukkan coding untuk form ini (ikuti lingkaran) klik 2 kali icon Code lalu ketik coding seperti disamping

5. Buat form baru untuk form jabatan dengan cara seperti gambar di bawah ini (Project > add form > open)

Setelah muncul form kosong seperti form sebelumnya, atur sedemikian rupa sehingga menjadi seperti dibawah ini

(Nama Form diubah menjadi frmJabatan)

keterangan komponen :

Biru = Command Button(sebagai tombol navigasi aplikasi), untuk merubah nama dapat dijumpai di Properties kolom Caption dan untuk variabelnya diberi nama cmdTambah (misal) pada kolom (name)

Merah = MsFlexiGrid (sebagai tabel yang akan menampilkan data), variabelnya diberi nama Grid Jabatan

Putih = TextBox (sebagai tempat input data) pada properties kolom text dikosongkan dan pada variabelnya diganti dengan txtJabatan (misal)

Kuning = Label (sebagai pemberi keterangan atau penanda) untuk merubah namanya ada di kolom Caption

Setelah selesai dengan desain maka masukkan Coding seperti dibawah ini
Option Explicit
Dim GridObjIndex As Byte
Dim KodeJabatan As String

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
    (Screen.Height – Height) / 3

    Call BukaDatabase
    Call TampilGridData
    Call FormMati
    
    TbHapus.Enabled = False
    TbSimpan.Enabled = False
    TbUbah.Enabled = False
End Sub

Sub FormKosong()
    txtKode.Text = “”
    txtNama.Text = “”
End Sub

Sub FormHidup()
    txtKode.Enabled = True
    txtNama.Enabled = True
End Sub

Sub FormMati()
    txtKode.Enabled = False
    txtNama.Enabled = False
End Sub

Sub FormNormal()
    FormKosong
    FormMati

    TbTambah.Enabled = True
    TbHapus.Enabled = False
    TbSimpan.Enabled = False
    TbUbah.Enabled = False
    TbKeluar.Caption = “&Keluar”
End Sub

Sub BuatKodeJabatan()
    Rs_Jabatan.Requery
    Set Rs_Jabatan = New ADODB.Recordset
    Set Rs_Jabatan = New ADODB.Recordset
    Rs_Jabatan.Open “SELECT * FROM Jabatan”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic

    If Rs_Jabatan.BOF Then
       KodeJabatan = “J0001”
       Exit Sub
    Else
     Rs_Jabatan.MoveLast
     KodeJabatan = Rs_Jabatan!Kode_Jabatan
     KodeJabatan = Right(KodeJabatan, 4)
     KodeJabatan = Val(KodeJabatan) + 1
     
     If Len(KodeJabatan) > 4 Then
        MsgBox “Kode jabatan baru melewati batas”, _
        vbCritical, “Error”
        Exit Sub
     End If
    End If
    KodeJabatan = “J” & Format(KodeJabatan, “0000”)
End Sub

Sub AktifGridJabatan()
    With GridJabatan
        .RowHeightMin = 300
        .Col = 0
        .Row = 0
        .Text = “NO”
        .CellFontBold = True
        .ColWidth(0) = 400
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .RowHeightMin = 300
        .Col = 1
        .Row = 0
        .Text = “KODE”
        .CellFontBold = True
        .ColWidth(1) = 800
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 2
        .Row = 0
        .Text = “NAMA JABATAN”
        .CellFontBold = True
        .ColWidth(2) = 6000
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
    End With
End Sub

Sub TampilGridData()
    Dim Baris As Integer
    GridJabatan.Clear
    AktifGridJabatan
    
    GridJabatan.Rows = 2
    Baris = 0
    
    Call BukaDatabase
    If Rs_Jabatan.BOF Then
        MsgBox “Tabel Jabatan masih kosong!”, _
        vbOKOnly + vbInformation, “Perhatian”
        Exit Sub
    Else
        With Rs_Jabatan
        .MoveFirst
        Do While Not .EOF
            On Error Resume Next
            Baris = Baris + 1
            GridJabatan.Rows = Baris + 1
            GridJabatan.TextMatrix(Baris, 0) = Baris
            GridJabatan.TextMatrix(Baris, 1) = !Kode_Jabatan
            GridJabatan.TextMatrix(Baris, 2) = !Nama_Jabatan
        .MoveNext
        Loop
        End With
    End If
End Sub

Private Sub GridJabatan_DblClick()
    TbHapus.Enabled = True
    TbSimpan.Enabled = False
    TbUbah.Enabled = True
    TbKeluar.Caption = “&Batal”
    TbTambah.Enabled = False
    
    Call FormHidup
    txtNama.SetFocus
    
    GridObjIndex = GridJabatan.Row
    
    Set Rs_Jabatan = New ADODB.Recordset
    Rs_Jabatan.Open ” SELECT * FROM Jabatan ” _
    & ” WHERE Kode_Jabatan='” _
    & GridJabatan.TextMatrix(GridObjIndex, 1) & “‘ ” _
    , KoneksiDB, adOpenDynamic, adLockBatchOptimistic
       
       If Rs_Jabatan.BOF Then
            MsgBox “Tabel Jabatan masih kosong!”, _
            vbOKOnly + vbInformation, “Perhatian”
            Exit Sub
            Call FormNormal
       Else
            Rs_Jabatan.MoveFirst
            Do While Not Rs_Jabatan.EOF
                On Error Resume Next
                txtKode.Text = Rs_Jabatan!Kode_Jabatan
                txtNama.Text = Rs_Jabatan!Nama_Jabatan
            Rs_Jabatan.MoveNext
            Loop
        End If
End Sub

‘# TOMBOL TAMBAH DIKLIK
Private Sub TbTambah_Click()
    Call FormHidup
    
    Call BuatKodeJabatan
    txtKode.Text = KodeJabatan
    
    TbSimpan.Enabled = True
    TbTambah.Enabled = False
    TbUbah.Enabled = False
    TbHapus.Enabled = False
    TbKeluar.Caption = “&Batal”
    txtNama.SetFocus
    
    Call TampilGridData
End Sub

Private Sub TbSimpan_Click()
    Dim Rs_Jabatan As New ADODB.Recordset
    Set Rs_Jabatan = KoneksiDB.Execute(“SELECT * ” _
    & ” FROM Jabatan ” _
    & ” WHERE Nama_Jabatan='” & txtNama.Text & “‘ “)

    If txtNama.Text = “” Then
        MsgBox “Nama Jabatan tidak boleh kosong!”, _
        vbInformation + vbOKOnly, “Perhatian”
        txtNama.SetFocus
    ElseIf Not Rs_Jabatan.BOF Then
        MsgBox “Maaf, Nama Jabatan” _
            & ” ” & UCase(txtNama.Text) _
            & ” Sudah Tersedia!!”, _
            vbInformation + vbOKOnly, “Information”
        txtNama.Text = “”
        txtNama.SetFocus
        Exit Sub
    Else
        SqlInsert = “INSERT INTO Jabatan ” _
            & ” (Kode_Jabatan,Nama_Jabatan) ” _
            & ” VALUES(‘” & txtKode.Text & “‘,'” _
            & txtNama.Text & “‘)”
                    
        KoneksiDB.Execute SqlInsert, , adCmdText
        Rs_Jabatan.Requery
        Call FormNormal
        Call Form_Load
        
        MsgBox “Data telah tersimpan dalam database !”, _
             vbOKOnly + vbInformation, “Konfirmasi”
    End If
End Sub

‘# TOMBOL UBAH DIKLIK
Private Sub TbUbah_Click()
    If txtNama.Text = “” Then
            MsgBox “Nama Jabatan tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtNama.SetFocus
    Else
        SqlUpdate = “UPDATE Jabatan” _
            & ” SET Nama_Jabatan='” & txtNama.Text & “‘ ” _
            & ” WHERE Kode_Jabatan='” & txtKode.Text & “‘”
                    
        KoneksiDB.Execute SqlUpdate, , adCmdText
        Rs_Jabatan.Requery
        Call FormNormal
        
        MsgBox “Data telah ter_update dalam database !”, _
        vbOKOnly + vbInformation, “Konfirmasi”
        
        Call Form_Load
    End If
End Sub

‘# TOMBOL HAPUS DIKLIK
Private Sub TbHapus_Click()
    Konfirmasi = MsgBox(“Anda yakin akan ” _
    & ” menghapus pesan ini?”, _
    vbYesNo + vbQuestion, “Konfirmasi”)
    If Konfirmasi = vbYes Then
        SqlDelete = “DELETE FROM Jabatan WHERE ” _
        & ” Kode_Jabatan='” & txtKode.Text & “‘”
        
        KoneksiDB.Execute SqlDelete, , adCmdText
        Rs_Jabatan.Requery
        Call FormNormal
        Call Form_Load
    Else
        Call FormNormal
    End If
End Sub

‘# TOMBOL KELUAR DIKLIK
Private Sub TbKeluar_Click()
    If TbKeluar.Caption = “&Keluar” Then
        Unload Me
    Else
        Call FormNormal
    End If
End Sub

Private Sub txtNama_KeyPress(KeyAscii As Integer)
    KeyAscii = Asc(UCase((Chr(KeyAscii))))
    If KeyAscii = vbKeyReturn Then
        TbSimpan.SetFocus
        KeyAscii = 0
    End If
End Sub

6. BUAT FORM BARU LAGI UNTUK FORM LOGIN (FRMLOGIN)

untuk komponen text box password pada properties Password Char karakternya diubah menjadi * (boleh bebas)

Source Code Login

Option Explicit
Dim MaxLogin As Integer

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
        (Screen.Height – Height) / 3
    
    Call BukaDatabase
    
    cmbStatus.AddItem (“ADMIN”)
    cmbStatus.AddItem (“BENDAHARA”)
End Sub

Private Sub TbLogin_Click()
    If txtUser.Text = “” Then
        MsgBox “KOTAK PENGGUNA MASIH KOSONG !”, _
        vbCritical + vbOKOnly, “Error”
        txtUser.SetFocus
    ElseIf txtPwd.Text = “” Then
        MsgBox “PASSWORD MASIH KOSONG !”, _
        vbCritical + vbOKOnly, “Error”
        txtPwd.SetFocus
    Else
        SQL = “”
        SQL = “SELECT * FROM Pengguna ” _
            & “WHERE UserID='” & txtUser.Text & “‘ ” _
            & ” AND PassID='” & txtPwd.Text & “‘” _
            & ” AND Status='” & cmbStatus.Text & “‘”
        Set Rs_Pengguna = KoneksiDB.Execute(SQL)
        
        If Not Rs_Pengguna.BOF Then
            If Rs_Pengguna!Status = “ADMIN” Then
                Unload Me
                FrmUtama.Enabled = True
                FrmUtama.Show
                FrmUtama.mnuLaporan.Enabled = True
                FrmUtama.mnuPegawai.Enabled = True
                FrmUtama.mnuJabatan.Enabled = True
                FrmUtama.mnuPengguna.Enabled = True
                FrmUtama.mnuTransaksi.Enabled = True
                FrmUtama.mnuUbahGaji.Enabled = True
                FrmUtama.mnuTransGaji.Enabled = True
                FrmUtama.mnuLapJual.Enabled = True
                FrmUtama.Toolbar1.Enabled = True
            Else
                Unload Me
                FrmUtama.Enabled = True
                FrmUtama.Show
                FrmUtama.mnuLaporan.Enabled = True
                FrmUtama.mnuLapBarang.Enabled = True
                FrmUtama.mnuLapJenis.Enabled = True
                FrmUtama.mnuTransGaji.Enabled = True
                FrmUtama.mnuUbahGaji.Enabled = False
                FrmUtama.mnuLapJual.Enabled = False
                FrmUtama.mnuPegawai.Enabled = False
                FrmUtama.mnuJabatan.Enabled = False
                FrmUtama.mnuPengguna.Enabled = False
                FrmUtama.mnuTransaksi.Enabled = True
                FrmUtama.Toolbar1.Enabled = False
            End If
             
            PenggunaID = Rs_Pengguna!UserId
            PenggunaNm = Rs_Pengguna!Nama
            
            With FrmUtama
            .StatusBar1.Panels(1).Text = Rs_Pengguna!Nama
            .StatusBar1.Panels(2).Text = “[” _
                & Rs_Pengguna!Status & “]”
            .mnuLogin.Enabled = True
            .mnuLogin.Caption = “Logout”
            End With
            
            Unload Me
        Else
            ‘ Periksa, login hanya 3 kali
            ‘ 3x gagal pesan error ditampilkan
            If MaxLogin < 3 Then
                MsgBox “PASSWORD MASIH SALAH, SILAHKAN ULANGI LAGI!”, _
                    vbCritical + vbOKOnly, “Error”
                txtPwd.Text = “”
                txtPwd.SetFocus
                MaxLogin = MaxLogin + 1
            Else
                MsgBox “ANDA BUKAN PENGGUNA. ANDA TIDAK BERHAK!”, _
                    vbCritical + vbOKOnly, “Error”
                End
            End If
        End If
    End If
End Sub

Private Sub TbTutup_Click()
    Unload Me
End Sub

7. Buat Form untuk Form Pegawai (frmPegawai)

Untuk komponen dan pengaturan desain masih sama

Source Code Form Pegawai
Option Explicit
Dim GridObjIndex As Byte
Dim Kd_Jenis As String
Dim KodePegawai As String
Dim KeteranganPegawai As String

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
        (Screen.Height – Height) / 3

    Call BukaDatabase
    Call TampilGridData
    Call FormMati
    
    TbHapus.Enabled = False
    TbSimpan.Enabled = False
    TbUbah.Enabled = False
    
    Call CmbJenis_Click
    Call cmbJenis_DropDown
End Sub

Sub FormKosong()
    txtKode.Text = “”
    cmbJenis.ListIndex = -1
    txtNama.Text = “”
    txtTunjangan.Text = “0”
    txtGaji.Text = “0”
    txtKeterangan.Text = “”
End Sub

Sub FormHidup()
    txtKode.Enabled = True
    cmbJenis.Enabled = True
    txtNama.Enabled = True
    txtTunjangan.Enabled = True
    txtGaji.Enabled = True
    txtKeterangan.Enabled = True
End Sub

Sub FormMati()
    txtKode.Enabled = False
    cmbJenis.Enabled = False
    txtNama.Enabled = False
    txtTunjangan.Enabled = False
    txtGaji.Enabled = False
    txtKeterangan.Enabled = False
End Sub

Sub FormNormal()
    Call FormKosong
    Call FormMati
    txtTunjangan.Locked = False
    
    TbTambah.Enabled = True
    TbHapus.Enabled = False
    TbSimpan.Enabled = False
    TbUbah.Enabled = False
    TbKeluar.Caption = “&Keluar”
End Sub

Private Sub CmbJenis_Click()
    Kd_Jenis = “”
    Set Rs_Jabatan = KoneksiDB.Execute(“SELECT * FROM ” _
        & ” Jabatan WHERE ” _
        & ” Nama_Jabatan='” & cmbJenis.Text & “‘”)
    With Rs_Jabatan
        If .EOF And .BOF Then
            Exit Sub
        Else
           Kd_Jenis = Rs_Jabatan!Kode_Jabatan
           txtNama.SetFocus
        End If
    End With
End Sub

Private Sub cmbJenis_DropDown()
    cmbJenis.Clear
    Set Rs_Jabatan = KoneksiDB.Execute(“SELECT * FROM ” _
        & ” Jabatan ORDER BY Nama_Jabatan”)
    If Not Rs_Jabatan.BOF Then
      While Not Rs_Jabatan.EOF
       cmbJenis.AddItem Rs_Jabatan!Nama_Jabatan
       Rs_Jabatan.MoveNext
      Wend
    End If
End Sub

Sub BuatKodePegawai()
    Rs_Pegawai.Requery
    Set Rs_Pegawai = New ADODB.Recordset
    Rs_Pegawai.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” ORDER BY NIP ASC “, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic

    If Rs_Pegawai.BOF Then
       KodePegawai = “P0001”
       Exit Sub
    Else
     Rs_Pegawai.MoveLast
     KodePegawai = Rs_Pegawai!NIP
     KodePegawai = Right(KodePegawai, 4)
     KodePegawai = Val(KodePegawai) + 1
     
     If Len(KodePegawai) > 4 Then
        MsgBox “NIP baru melewati batas”, _
        vbCritical, “Error”
        Exit Sub
     End If
    End If
    KodePegawai = “P” & Format(KodePegawai, “0000”)
End Sub

Sub AktifGridPegawai()
    With GridPegawai
        .RowHeightMin = 300
        .Col = 0
        .Row = 0
        .Text = “NO”
        .CellFontBold = True
        .ColWidth(0) = 400
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .RowHeightMin = 300
        .Col = 1
        .Row = 0
        .Text = “NIP”
        .CellFontBold = True
        .ColWidth(1) = 750
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 2
        .Row = 0
        .Text = “JABATAN”
        .CellFontBold = True
        .ColWidth(2) = 1900
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 3
        .Row = 0
        .Text = “NAMA PEGAWAI”
        .CellFontBold = True
        .ColWidth(3) = 3300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 4
        .Row = 0
        .Text = “TUNJANGAN [Rp.]”
        .CellFontBold = True
        .ColWidth(4) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 5
        .Row = 0
        .Text = “GAJI POKOK [Rp.]”
        .CellFontBold = True
        .ColWidth(5) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 6
        .Row = 0
        .Text = “KETERANGAN”
        .CellFontBold = True
        .ColWidth(6) = 3000
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
    End With
End Sub

Sub TampilGridData()
    Dim Baris As Integer
    GridPegawai.Clear
    Call AktifGridPegawai
    
    GridPegawai.Rows = 2
    Baris = 0
    
    Call BukaDatabase
    
    If Rs_Pegawai.BOF Then
        MsgBox “Tabel Pegawai masih kosong!”, _
        vbOKOnly + vbInformation, “Perhatian”
        Exit Sub
    Else
        With Rs_Pegawai
        .MoveFirst
        Do While Not .EOF
            On Error Resume Next
            Baris = Baris + 1
            GridPegawai.Rows = Baris + 1
            GridPegawai.TextMatrix(Baris, 0) = Baris
            GridPegawai.TextMatrix(Baris, 1) = !NIP
            GridPegawai.TextMatrix(Baris, 2) = !Nama_Jabatan
            GridPegawai.TextMatrix(Baris, 3) = !Nm_Pegawai
            GridPegawai.TextMatrix(Baris, 4) = !Tunjangan
            GridPegawai.TextMatrix(Baris, 5) = !Gaji_Pokok
            GridPegawai.TextMatrix(Baris, 6) = !Keterangan
        .MoveNext
        Loop
        End With
    End If
End Sub

Private Sub GridPegawai_DblClick()
    TbHapus.Enabled = True
    TbSimpan.Enabled = False
    TbUbah.Enabled = True
    TbKeluar.Caption = “&Batal”
    TbTambah.Enabled = False
    txtGaji.Locked = True
    
    Call FormHidup
    cmbJenis.SetFocus
    
    GridObjIndex = GridPegawai.Row
    
    Set Rs_Pegawai = New ADODB.Recordset
    Rs_Pegawai.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND NIP='” _
        & GridPegawai.TextMatrix(GridObjIndex, 1) _
        & “‘ ORDER BY NIP ASC “, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        
       If Rs_Pegawai.BOF Then
            MsgBox “Tabel Pegawai masih kosong!”, _
            vbOKOnly + vbInformation, “Perhatian”
            Exit Sub
            Call FormNormal
       Else
            Rs_Pegawai.MoveFirst
            Do While Not Rs_Pegawai.EOF
                On Error Resume Next
                txtKode.Text = Rs_Pegawai!NIP
                cmbJenis.Text = Rs_Pegawai!Nama_Jabatan
                txtNama.Text = Rs_Pegawai!Nm_Pegawai
                txtTunjangan.Text = Rs_Pegawai!Tunjangan
                txtGaji.Text = Rs_Pegawai!Gaji_Pokok
                txtKeterangan.Text = Rs_Pegawai!Keterangan
            Rs_Pegawai.MoveNext
            Loop
        End If
End Sub

Private Sub TbTambah_Click()
    Call FormHidup
    Call BuatKodePegawai
    txtKode.Text = KodePegawai
    
    TbSimpan.Enabled = True
    TbTambah.Enabled = False
    TbUbah.Enabled = False
    TbHapus.Enabled = False
    TbKeluar.Caption = “&Batal”
    cmbJenis.SetFocus
    
    Call TampilGridData
End Sub

Private Sub TbSimpan_Click()
    If cmbJenis.ListIndex = -1 Then
        MsgBox “Jenis Jabatan tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            cmbJenis.SetFocus
    ElseIf txtNama.Text = “” Then
        MsgBox “Nama Pegawai tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtNama.SetFocus
    ElseIf txtTunjangan.Text = “” Or txtTunjangan.Text = “0” Then
        MsgBox “Tunjangan tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtTunjangan.SetFocus
    ElseIf txtGaji.Text = “” Then
        MsgBox “Gaji Pegawai tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtGaji.SetFocus
    Else
        If txtKeterangan = “” Then
            KeteranganPegawai = “Tidak ada keterangan”
        Else
            KeteranganPegawai = txtKeterangan.Text
        End If
    
        SqlInsert = “INSERT INTO Pegawai ” _
            & ” (NIP,Kode_Jabatan, Nm_Pegawai, ” _
            & ” Tunjangan,Gaji_Pokok, Keterangan)” _
            & ” VALUES(‘” & txtKode.Text & “‘,'” _
            & Kd_Jenis & “‘,'” & txtNama.Text & “‘,'” _
            & txtTunjangan.Text & “‘,'” & txtGaji.Text & “‘,'” _
            & KeteranganPegawai & “‘)”
                
        KoneksiDB.Execute SqlInsert, , adCmdText
        Rs_Pegawai.Requery
        Call FormNormal
        Call Form_Load
        
        MsgBox “Data telah tersimpan dalam database !”, _
            vbOKOnly + vbInformation, “Konfirmasi”
    End If
End Sub

Private Sub TbUbah_Click()
    If cmbJenis.ListIndex = -1 Then
        MsgBox “Jabatan tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            cmbJenis.SetFocus
    ElseIf txtNama.Text = “” Then
        MsgBox “Nama Pegawai tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtNama.SetFocus
    ElseIf txtTunjangan.Text = “” Or txtTunjangan.Text = “0” Then
        MsgBox “Tunjangan tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtTunjangan.SetFocus
    ElseIf txtGaji.Text = “” Then
        MsgBox “Gaji tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtGaji.SetFocus
    Else
        If txtKeterangan = “” Then
            KeteranganPegawai = “Tidak ada keterangan”
        Else
            KeteranganPegawai = txtKeterangan.Text
        End If
        
        SqlUpdate = “UPDATE Pegawai” _
            & ” SET Kode_Jabatan='” & Kd_Jenis & ” ‘, ” _
            & ” Nm_Pegawai='” & txtNama.Text & “‘, ” _
            & ” Tunjangan='” & txtTunjangan.Text & “‘, ” _
            & ” Gaji_Pokok='” & txtGaji.Text & “‘, ” _
            & ” Keterangan='” & KeteranganPegawai & “‘ ” _
            & ” WHERE NIP='” & txtKode.Text & “‘”
                    
        KoneksiDB.Execute SqlUpdate, , adCmdText
        Rs_Pegawai.Requery
        Call FormNormal
        
        MsgBox “Data telah terbaharui dalam database !”, _
        vbOKOnly + vbInformation, “Konfirmasi”
        
        Call Form_Load
    End If
End Sub

Private Sub TbHapus_Click()
    Konfirmasi = MsgBox(“Anda yakin akan ” _
    & ” menghapus pesan ini?”, _
    vbYesNo + vbQuestion, “Konfirmasi”)
    If Konfirmasi = vbYes Then
        SqlDelete = “DELETE FROM Pegawai WHERE  ” _
            & ” NIP='” & txtKode.Text & “‘”
        
        KoneksiDB.Execute SqlDelete, , adCmdText
        Rs_Pegawai.Requery
        Call FormNormal
        Call Form_Load
    Else
        Call FormNormal
    End If
End Sub

Private Sub TbKeluar_Click()
    If TbKeluar.Caption = “&Keluar” Then
        Unload Me
    Else
        FormNormal
    End If
End Sub

Private Sub txtTunjangan_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtGaji.SetFocus
    ElseIf Not (KeyAscii >= Asc(“0”) _
    And KeyAscii <= Asc(“9”) _
    Or KeyAscii = vbKeyBack) Then
        Beep
        KeyAscii = 0
    End If
End Sub

Private Sub txtKeterangan_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        TbSimpan.SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub txtNama_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtTunjangan.SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub txtGaji_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtKeterangan.SetFocus
    ElseIf Not (KeyAscii >= Asc(“0”) _
    And KeyAscii <= Asc(“9”) _
    Or KeyAscii = vbKeyBack) Then
        Beep
        KeyAscii = 0
    End If
End Sub

8. Buat Form untuk Form Pengguna

Kuning = Combo box (pilihan)

SourceCode
Option Explicit
Dim GridBaris As Byte
Dim TmpPassword As String
Dim NewPassword As String
Dim Tanya As String

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
        (Screen.Height – Height) / 3
   
    Call BukaDatabase
    Call TampilGridData
    
    cmbStatus.Clear
    
    cmbStatus.AddItem (“ADMIN”)
    cmbStatus.AddItem (“BENDAHARA”)
    
    TbUbah.Enabled = False
    TbSimpan.Enabled = False
    TbHapus.Enabled = False
    
    Call FormMati
End Sub

Sub FormKosong()
    txtUserId.Text = “”
    txtPassword.Text = “”
    txtNama.Text = “”
    cmbStatus.ListIndex = -1
End Sub

Sub FormHidup()
    txtUserId.Enabled = True
    txtPassword.Enabled = True
    txtNama.Enabled = True
    cmbStatus.Enabled = True
    
    txtUserId.BackColor = &HFFFFFF
    txtPassword.BackColor = &HFFFFFF
    txtNama.BackColor = &HFFFFFF
    cmbStatus.BackColor = &HFFFFFF
End Sub

Sub FormMati()
    txtUserId.Enabled = False
    txtPassword.Enabled = False
    txtNama.Enabled = False
    cmbStatus.Enabled = False
    
    txtUserId.BackColor = &HC0FFFF
    txtPassword.BackColor = &HC0FFFF
    txtNama.BackColor = &HC0FFFF
    cmbStatus.BackColor = &HC0FFFF
End Sub

Sub FormNormal()
    Call FormKosong
    Call FormMati
 
    TbBaru.Enabled = True
    TbUbah.Enabled = False
    TbHapus.Enabled = False
    TbSimpan.Enabled = False
    TbKeluar.Caption = “&Keluar”
End Sub

Sub AktifGridPengguna()
    With GridPengguna
        
        .RowHeightMin = 300
        .Col = 0
        .Row = 0
        .Text = “USER ID”
        .CellFontBold = True
        .ColWidth(0) = 1300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 1
        .Row = 0
        .Text = “PASSWORD”
        .CellFontBold = True
        .ColWidth(1) = 1300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 2
        .Row = 0
        .Text = “NAMA PEMILIK”
        .CellFontBold = True
        .ColWidth(2) = 3700
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 3
        .Row = 0
        .Text = “STATUS”
        .CellFontBold = True
        .ColWidth(3) = 1300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
    End With
End Sub

Sub TampilGridData()
    Dim Baris As Integer
    GridPengguna.Clear
    Call AktifGridPengguna
    
    GridPengguna.Rows = 2
    Baris = 0
    
    Set Rs_Pengguna = New ADODB.Recordset
    Rs_Pengguna.Open “SELECT * FROM Pengguna”, _
        KoneksiDB, adOpenDynamic, adLockOptimistic

    If Rs_Pengguna.BOF Then
        MsgBox “DATA Pengguna MASIH KOSONG!”, _
        vbOKOnly + vbInformation, “Perhatian”
        Exit Sub
    Else
        With Rs_Pengguna
        .MoveFirst
        Do While Not .EOF
            On Error Resume Next
            Baris = Baris + 1
            GridPengguna.Rows = Baris + 1
            GridPengguna.TextMatrix(Baris, 0) = !UserId
            GridPengguna.TextMatrix(Baris, 1) = “xxxxxxx”
            GridPengguna.TextMatrix(Baris, 2) = !Nama
            GridPengguna.TextMatrix(Baris, 3) = !Status
        .MoveNext
        Loop
        End With
    End If
End Sub

Private Sub GridPengguna_DblClick()
    TbHapus.Enabled = True
    TbSimpan.Enabled = False
    TbUbah.Enabled = True
    TbKeluar.Caption = “&Normal”
    TbBaru.Enabled = False
    txtUserId.Locked = True
    
    Call FormHidup
    txtPassword.SetFocus
    
    GridBaris = GridPengguna.Row
    
    Set Rs_Pengguna = New ADODB.Recordset
    Rs_Pengguna.Open “SELECT * FROM Pengguna ” _
        & ” WHERE UserId='” _
        & GridPengguna.TextMatrix(GridBaris, 0) & “‘”, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
    
    If Rs_Pengguna.BOF Then
        MsgBox “TABEL MASIH KOSONG”, _
        vbOKOnly + vbInformation, “Perhatian”
        Exit Sub
        Call FormNormal
    Else
        Rs_Pengguna.MoveFirst
        Do While Not Rs_Pengguna.EOF
            On Error Resume Next
            txtUserId.Text = Rs_Pengguna!UserId
            txtNama.Text = Rs_Pengguna!Nama
            cmbStatus.Text = Rs_Pengguna!Status
            
            TmpPassword = Rs_Pengguna!PassId
        Rs_Pengguna.MoveNext
        Loop
    End If
End Sub

Private Sub TbBaru_Click()
    Call FormHidup
    Call TampilGridData
    
    TbSimpan.Enabled = True
    TbBaru.Enabled = False
    TbHapus.Enabled = False
    TbKeluar.Caption = “&Normal”
    
    txtUserId.Locked = False
    txtUserId.SetFocus
End Sub

Private Sub TbSimpan_Click()
    Set Rs_Pengguna = New ADODB.Recordset
    Rs_Pengguna.Open “SELECT * FROM Pengguna WHERE ” _
        & ” UserId='” & Trim(txtUserId.Text) & “‘”, _
    KoneksiDB, adOpenDynamic, adLockBatchOptimistic

    If Len(txtUserId.Text) <= 4 Then
        MsgBox “USER ID MINIMAL 4 DIGIT”, _
            vbOKOnly + vbCritical, “Error”
        txtUserId.SetFocus
    ElseIf txtNama.Text = “” Then
        MsgBox “NAMA BELUM DIISI”, _
            vbOKOnly + vbCritical, “Error”
        txtNama.SetFocus
    ElseIf Not Rs_Pengguna.BOF Then
        MsgBox “Maaf, UserId” _
            & ” ” & UCase(txtUserId.Text) _
            & ” sudah tersedia!!”, _
            vbInformation + vbOKOnly, “Information”
        txtUserId.Text = “”
        txtUserId.SetFocus
        Exit Sub
    Else
        SqlInsert = “INSERT INTO Pengguna ” _
            & ” (UserId,PassId,Nama,Status) ” _
            & ” VALUES(‘” & Trim(txtUserId.Text) & “‘,'” _
            & Trim(txtPassword.Text) & “‘,'” _
            & Trim(txtNama.Text) & “‘,'” _
            & Trim(cmbStatus.Text) & “‘)”
                
        KoneksiDB.Execute SqlInsert, , adCmdText
        Rs_Pengguna.Requery
        
        Call FormNormal
        Call Form_Load
            MsgBox “DATA PENGGUNA BARU TELAH TERSIMPAN”, _
                vbOKOnly + vbInformation, “Sukses”
    End If
End Sub

Private Sub TbUbah_Click()
    Set Rs_Pengguna = New ADODB.Recordset
    Rs_Pengguna.Open “SELECT * FROM Pengguna WHERE ” _
        & ” UserId='” & Trim(txtUserId.Text) & “‘”, _
    KoneksiDB, adOpenDynamic, adLockBatchOptimistic
    
    If txtNama.Text = “” Then
        MsgBox “NAMA TIDAK BOLEH KOSONG”, _
            vbOKOnly + vbCritical, “Error”
        txtNama.SetFocus
    Else
        If Trim(txtPassword.Text) = “” Then
            NewPassword = TmpPassword
        Else
            NewPassword = txtPassword.Text
        End If
        
        Tanya = MsgBox(“UBAH DATA PENGGUNA DARI : ” _
            & vbCrLf & “” & “NAMA LAMA : ” _
            & Rs_Pengguna.Fields!Nama + vbCrLf & “” _
            & “NAMA BARU : ” & txtNama.Text + vbCrLf & “”, _
            vbYesNo + vbQuestion, “Perhatian !”)

        If Tanya = vbYes Then
            SqlUpdate = “UPDATE Pengguna” _
                & ” SET PassId='” & NewPassword & ” ‘, ” _
                & ” Nama='” & Trim(txtNama.Text) & “‘, ” _
                & ” Status='” & Trim(cmbStatus.Text) & “‘ ” _
                & ” WHERE UserId='” & Trim(txtUserId.Text) & “‘”
                        
            KoneksiDB.Execute SqlUpdate, , adCmdText
        End If
        
        Rs_Pegawai.Requery
        Call FormNormal
        Call Form_Load
    End If

End Sub

Private Sub TbHapus_Click()
    Tanya = MsgBox(“YAKIN HAPUS DATA INI ?” _
            & vbCrLf & “” & “USER ID : ” _
            & txtUserId + vbCrLf & “” _
            & “NAMA : ” & txtNama.Text + vbCrLf & “”, _
         vbYesNo + vbQuestion, “Perhatian !”)
    If Tanya = vbYes Then
        SQL = “DELETE FROM Pengguna WHERE ” _
            & ” UserId='” & txtUserId.Text & “‘”
        KoneksiDB.Execute SQL, , adCmdText
        
        Rs_Pengguna.Requery
        Call FormNormal
        Call FormMati
        Call TampilGridData
    Else
        Call FormNormal
    End If
End Sub

Private Sub TbKeluar_Click()
    If TbKeluar.Caption = “&Keluar” Then
        Unload Me
    Else
        Call FormNormal
    End If
End Sub

Private Sub txtUserId_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtPassword.SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtNama.SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub txtNama_KeyPress(KeyAscii As Integer)
    KeyAscii = Asc(UCase((Chr(KeyAscii))))
    If KeyAscii = vbKeyReturn Then
        cmbStatus.SetFocus
        KeyAscii = 0
    End If
End Sub

9. Buat Form untuk Form Utama (frmUtama)

Ikuti jalur warna

Orange = Image List(memasukkan gambar pada tool bar)

Biru = Menu Editor (tampilan menu dsn sub menu)

Kuning = Toolbar (Temapt untukmenaruh imagae dari image list)

SourceCode

Option Explicit
Private Sub Form_Unload(Cancel As Integer)
    If MsgBox(“YAKIN AKAN MENUTUP APLIKASI INI..?”, _
         vbQuestion, “Konfirmasi”) = vbNo Then
        Cancel = 1
    Else
        End
    End If
End Sub

Private Sub mnuLapJenis_Click()
    With rptJenis
    .Sections(“Section4”).Controls(“Label5”).Caption = _
        Format(Date, “dd MMMM yyyy”)
    .Show 1
    End With
End Sub

Private Sub mnuJualTgl_Click()
    frmLapJualTgl.Show 1
End Sub

Private Sub mnuLPengguna_Click()
    With rptPengguna
    .Sections(“Section4”).Controls(“Label8”).Caption = _
        Format(Date, “dd MMMM yyyy”)
    .Show 1
    End With
End Sub

Private Sub mnuPengguna_Click()
    frmPengguna.Show 1
End Sub

Private Sub mnuJabatan_Click()
    frmJabatan.Show 1, FrmUtama
End Sub

Private Sub mnuKeluar_Click()
    End
End Sub

Private Sub mnuLapJual_Click()
    With rptLapPenggajian
    .Sections(“Section4”).Controls(“Label5”).Caption = _
        Format(Date, “dd MMMM yyyy”)
    .Show 1
    End With
End Sub

Private Sub mnuLapBarang_Click()
    With rptPegawai
    .Sections(“Section4”).Controls(“Label5”).Caption = _
        Format(Date, “dd MMMM yyyy”)
    .Show 1
    End With
End Sub

Private Sub mnuLogin_Click()
    If FrmUtama.mnuLogin.Caption = “Login” Then
        frmLogin.Show 1
    Else
        mnuLaporan.Enabled = False
        mnuPegawai.Enabled = False
        mnuJabatan.Enabled = False
        mnuUbahGaji.Enabled = False
        mnuPengguna.Enabled = False
        mnuTransaksi.Enabled = False
        Toolbar1.Enabled = False

        Me.mnuLogin.Caption = “Login”
    End If
End Sub

Private Sub mnuPegawai_Click()
    frmPegawai.Show 1, FrmUtama
End Sub

Private Sub mnuBarangJenis_Click()
    frmLapBarangJenis.Show 1
End Sub

Private Sub mnuUbahGaji_Click()
    frmUbahGaji.Show 1
End Sub

Private Sub mnuTransGaji_Click()
    frmGaji.Show 1, FrmUtama
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Index
        Case 1:
            frmJabatan.Show 1
        Case 2:
            frmPegawai.Show 1
        Case 4:
            frmGaji.Show 1
        Case 6:
            frmLogin.Show 1
    End Select
End Sub

10. Buat Form untuk Form Ubah Gaji (frmUbahGaji)

Text pada properties digantimenjadi nol

SourceCode
Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
        (Screen.Height – Height) / 3

    Call BukaDatabase
    Call FormMati

    Label7.Visible = False
    txtGajiLama.Visible = False
    
    TbCari.Enabled = False
    TbSimpan.Enabled = False
End Sub

Sub FormKosong()
    txtKode.Text = “”
    txtJenis.Text = “”
    txtNama.Text = “”
    txtTunjangan.Text = “0”
    txtGaji.Text = “0”
    txtGajiLama.Text = “”
    txtKeterangan.Text = “”
End Sub

Sub FormHidup()
    txtKode.Enabled = True
    txtJenis.Enabled = True
    txtNama.Enabled = True
    txtTunjangan.Enabled = True
    txtGaji.Enabled = True
    txtKeterangan.Enabled = True
End Sub

Sub FormMati()
    txtKode.Enabled = False
    txtJenis.Enabled = False
    txtNama.Enabled = False
    txtTunjangan.Enabled = False
    txtGaji.Enabled = False
    txtKeterangan.Enabled = False
End Sub

Sub FormNormal()
    Call FormKosong
    Call FormMati
    txtGaji.Locked = False
    Label7.Visible = False
    txtGajiLama.Visible = False

    TbCari.Enabled = False
    TbTambah.Enabled = True
    TbSimpan.Enabled = False
    TbKeluar.Caption = “&Keluar”
End Sub

Private Sub TbCari_Click()
    FrmUtama.Enabled = False
    frmUbahGaji.Enabled = False
    frmCariPegawai.Show 1
End Sub

Private Sub TbKeluar_Click()
    If TbKeluar.Caption = “&Keluar” Then
        FrmUtama.Enabled = True
        Unload Me
    Else
        FormNormal
    End If
End Sub

Private Sub TbSimpan_Click()
    If txtGaji.Text = “” Or txtGaji.Text = “0” Then
        MsgBox “Gaji tidak boleh kosong!”, _
            vbInformation + vbOKOnly, “Perhatian”
            txtGaji.SetFocus
    Else
    
        SqlUpdate = “”
        SqlUpdate = “UPDATE Pegawai” _
            & ” SET Gaji_Pokok='” & txtGaji.Text & “‘ ” _
            & ” WHERE NIP='” & txtKode.Text & “‘”
                    
        KoneksiDB.Execute SqlUpdate, , adCmdText
        Rs_Pegawai.Requery
        Call FormNormal
        
        MsgBox “Data telah terbaharui dalam database !”, _
        vbOKOnly + vbInformation, “Konfirmasi”
        
        Call Form_Load
    End If
End Sub

Private Sub TbTambah_Click()
    Call FormHidup
    TbCari.Enabled = True
    TbSimpan.Enabled = True
    TbTambah.Enabled = False
    TbKeluar.Caption = “&Batal”
    txtKode.SetFocus
End Sub

Private Sub txtKode_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If Len(txtKode.Text) < 5 Then
            MsgBox “NOMOR INDUK PEGAWAI HARUS 5 DIGIT”, _
            vbCritical, “Error”
            Exit Sub
        End If
        KeyAscii = 0
        Label7.Visible = True
        txtGajiLama.Visible = True

        Set Rs_Pegawai = New ADODB.Recordset
        Rs_Pegawai.Open “SELECT Pegawai.*, ” _
            & ” Jabatan.Nama_Jabatan ” _
            & ” FROM Pegawai, Jabatan WHERE ” _
            & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
            & ” AND Pegawai.NIP='” _
            & txtKode.Text & “‘ “, _
            KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        If Rs_Pegawai.BOF Then
            MsgBox “NIP TIDAK DIKENALI ..”, _
            vbInformation, “Info”
        Else
            With Rs_Pegawai
            txtJenis.Text = !Nama_Jabatan
            txtNama.Text = !Nm_Pegawai
            txtTunjangan.Text = !Tunjangan
            txtGajiLama.Text = !Gaji_Pokok
            txtKeterangan = !Keterangan
            txtGaji.SetFocus
            End With
        End If
    End If
End Sub

Private Sub txtGaji_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        TbSimpan.SetFocus
    ElseIf Not (KeyAscii >= Asc(“0”) _
    And KeyAscii <= Asc(“9”) _
    Or KeyAscii = vbKeyBack) Then
        Beep
        KeyAscii = 0
    End If
End Sub

11. Buat Form Untuk Form Penggajian(frmGaji)

SourceCode

Option Explicit
Dim Baris As Integer
Dim i As Integer
Dim Tanya As String
Dim NoNota As String

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
        (Screen.Height – Height) / 3
    
    Call BukaDatabase
    Call FormMati
    
    TbSimpan.Enabled = False
    TbCari.Enabled = False
    TbMasuk.Enabled = False
End Sub

Sub FormKosong()
    txtNoNota.Text = “”
    txtTgl.Text = “__/__/____”
    txtKode.Text = “”
    txtNama.Text = “”
    txtGaji.Text = “”
    txtTunjangan.Text = “”
    txtKas.Text = “”
    txtTotal.Text = “0”
    txtTotalHarga = “0”
    txtKembali.Text = “0”
    txtCash.Text = “0”
    
    Baris = 1
    GridPenggajian.Clear
    GridPenggajian.Rows = 2
    Call AktifGridGaji
End Sub

Sub FormTransKosong()
    txtTotalHarga.Text = “0”
    txtCash.Text = “”
    txtKembali.Text = “0”
End Sub

Sub FormMati()
    txtNoNota.Enabled = False
    txtTgl.Enabled = False
    txtKode.Enabled = False
    txtNama.Enabled = False
    txtGaji.Enabled = False
    txtTunjangan.Enabled = False
    txtKas.Enabled = False
    txtTotal.Enabled = False
     txtTotalHarga.Enabled = False
    txtCash.Enabled = False
    txtKembali.Enabled = False
End Sub

Sub FormHidup()
    txtNoNota.Enabled = True
    txtTgl.Enabled = True
    txtKode.Enabled = True
    txtNama.Enabled = True
    txtGaji.Enabled = True
    txtTunjangan.Enabled = True
    txtKas.Enabled = True
    txtTotal.Enabled = True
    txtTotalHarga.Enabled = True
    txtCash.Enabled = True
    txtKembali.Enabled = True

End Sub

Sub FormNormal()
    FormMati
    FormKosong
    
    TbKeluar.Caption = “&Keluar”
    TbSimpan.Enabled = False
    TbBaru.Enabled = True
    TbCari.Enabled = False
    TbMasuk.Enabled = False
End Sub

Sub BuatNotaJual()
    Rs_Penggajian.Requery
    Set Rs_Penggajian = New ADODB.Recordset
    Rs_Penggajian.Open ” SELECT * FROM ” _
        & ” Penggajian ORDER BY No_Nota “, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic

    If Rs_Penggajian.BOF Then
       NoNota = “GJ-00001”
       Exit Sub
    Else
     Rs_Penggajian.MoveLast
     NoNota = Rs_Penggajian!No_Nota
     NoNota = Right(NoNota, 5)
     NoNota = Val(NoNota) + 1
     
     If Len(NoNota) > 5 Then
        MsgBox “Nomor nota baru melewati batas”, _
            vbCritical, “Error”
        Exit Sub
     End If
    End If
    NoNota = “GJ-” & Format(NoNota, “00000”)
End Sub

Sub AktifGridGaji()
    With GridPenggajian
        .Col = 0
        .Row = 0
        .Text = “KODE”
        .CellFontBold = True
        .ColWidth(0) = 1300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 1
        .Row = 0
        .Text = “NAMA PEGAWAI”
        .CellFontBold = True
        .ColWidth(1) = 4200
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
    
        .Col = 2
        .Row = 0
        .Text = “GAJI (Rp)”
        .CellFontBold = True
        .ColWidth(2) = 1800
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 3
        .Row = 0
        .Text = “KAS”
        .CellFontBold = True
        .ColWidth(3) = 1300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 4
        .Row = 0
        .Text = “SUBTOTAL (Rp)”
        .CellFontBold = True
        .ColWidth(4) = 1800
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
    End With
End Sub

Private Sub TbBaru_Click()
    txtTgl.Text = Format(Date, “dd/MM/yyyy”)
    Call FormHidup
    Call AktifGridGaji
    
    Call BuatNotaJual
    txtNoNota.Text = NoNota
    
    TbBaru.Enabled = False
    TbCari.Enabled = True
    TbKeluar.Caption = “&Batal”
    TbSimpan.Enabled = True
    TbMasuk.Enabled = True
    
    Baris = 1
End Sub

Private Sub TbCari_Click()
    FrmUtama.Enabled = False
    frmGaji.Enabled = False
    frmCariGaji.Show 1
End Sub

Private Sub TbMasuk_Click()
    If txtKode.Text = “” Then
        MsgBox “Barang masih kosong! “, _
        vbOKOnly + vbCritical, “Konfirmasi”
        TbCari.SetFocus
    ElseIf Val(txtKas.Text) > _
        Val(txtGaji.Text) Then
        MsgBox “Maaf..! Gaji tidak memadai .”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtKas.Text = “0”
        txtKas.SetFocus
    ElseIf txtKas.Text = “” _
        Or txtKas.Text = “” Then
        MsgBox “Kas masih kosong! “, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtKas.SetFocus
    ElseIf GridPenggajian.Rows = 1 Then
        MsgBox “Belum ada Pegawai yang anda Input!”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        TbCari.SetFocus
    ElseIf txtGaji.Text = “1” Then
        MsgBox “Gaji minimum!”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        Call BersihPegawai
    ElseIf Val(txtGaji.Text) = _
        Val(txtKas.Text) Then
        MsgBox “Kas tidak boleh melebihi Gaji!”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtKas.Text = Val(txtKas.Text) – 1
        TbMasuk.SetFocus
    Else
        With GridPenggajian
            .Rows = Baris + 1
            .TextMatrix(Baris, 0) = txtKode.Text
            .TextMatrix(Baris, 1) = txtNama.Text
            .TextMatrix(Baris, 2) = txtGaji.Text
            .TextMatrix(Baris, 3) = txtKas.Text
            .TextMatrix(Baris, 4) = txtTotal.Text
        End With
        
        txtTotalHarga.Text = _
            Val(txtTotalHarga.Text) + Val(txtTotal.Text)
        
        Baris = Baris + 1
        Call BersihPegawai
    End If
End Sub

Private Sub TbSimpan_Click()
    Dim i As Integer

    If txtNoNota.Text = “” Then
        MsgBox “Nomor transaksi masih kosong !”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtNoNota.SetFocus
    ElseIf Baris = 1 Then
        MsgBox “Belum ada pegawai yang anda Input!”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        TbCari.SetFocus
    ElseIf txtCash.Text = “” Then
        MsgBox “Belum melakukan pembayaran ! “, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtCash.SetFocus
    ElseIf Val(txtCash.Text) < _
        Val(txtTotalHarga.Text) Then
        MsgBox “Pembayaran masih kurang”, _
        vbOKOnly + vbCritical, “Konfirmasi”
        txtCash.SetFocus
    Else
        SqlInsert = “”
        SqlInsert = “INSERT INTO Penggajian” _
            & “(No_Nota,Tgl_Nota,Total,UserId)” _
            & “VALUES (‘” & txtNoNota.Text & “‘,'” _
            & Format(Date, “yyyy-MM-dd”) & “‘,'” _
            & txtTotalHarga.Text & ” ‘,'” _
            & PenggunaID & “‘)”
        KoneksiDB.Execute SqlInsert, , adCmdText
        Rs_Penggajian.Requery
            
        For i = 1 To Baris – 1
            SqlInsert = “”
            SqlInsert = “INSERT INTO Detail_Penggajian” _
                & “(No_Nota,NIP,Tunjangan_Krj, ” _
                & ” Kas,SubTotal)” _
                & ” VALUES (‘” & txtNoNota.Text & “‘,'” _
                & GridPenggajian.TextMatrix(i, 0) & “‘,'” _
                & GridPenggajian.TextMatrix(i, 2) & “‘,'” _
                & GridPenggajian.TextMatrix(i, 3) & “‘,'” _
                & GridPenggajian.TextMatrix(i, 4) & “‘)”
            KoneksiDB.Execute SqlInsert, , adCmdText
                
            SqlUpdate = “”
            SqlUpdate = “UPDATE Pegawai SET ” _
                & ” Gaji_Pokok=Gaji_Pokok – ” _
                & Val(GridPenggajian.TextMatrix(i, 3)) & “” _
                & ” WHERE NIP='” _
                & GridPenggajian.TextMatrix(i, 0) & “‘”
            KoneksiDB.Execute SqlUpdate, , adCmdText
        Next i
        MsgBox “Data telah tersimpan dalam database !”, _
        vbOKOnly + vbInformation, “Konfirmasi”
             
        On Error Resume Next
        With frmCetakGaji
            .NoNota = txtNoNota.Text
            .TotHarga = txtTotalHarga.Text
            .UangBayar = txtCash.Text
            .UangKembali = txtKembali.Text
            .Show 1
        End With

        Call FormNormal
        Call FormTransKosong
    End If
End Sub

Private Sub TbKeluar_Click()
    If TbKeluar.Caption = “&Keluar” Then
        Tanya = MsgBox(“ANDA YAKIN AKAN ” _
            & ” MENGAKHIRI APLIKASI INI..?”, _
            vbQuestion + vbYesNo, “Exit”)
        If Tanya = vbYes Then
            FrmUtama.Enabled = True
            Unload Me
        Else
            Exit Sub
        End If
    Else
        Call FormNormal
    End If
End Sub

Sub BersihPegawai()
    txtKode.Text = “”
    txtNama.Text = “”
    txtTunjangan.Text = “0”
    txtGaji.Text = “0”
    txtKas.Text = “”
    txtTotal.Text = “0”
End Sub
Private Sub txtKas_Change()
    On Error Resume Next
    If txtKas.Text = “” Or txtTunjangan.Text = “” Or txtGaji.Text = “” Then
        txtTotal.Text = “”
        Exit Sub
    Else
        txtTotal.Text = (txtTunjangan.Text + (txtGaji.Text – txtKas.Text))
    End If
End Sub
Private Sub txtCash_Change()
    On Error Resume Next

    If txtCash.Text = “” Or txtTotalHarga.Text = “” Then
        txtKembali.Text = “0”
        Exit Sub
    Else
        txtKembali.Text = _
           Val(txtCash.Text) + Val(txtTotalHarga.Text)
    End If
End Sub

Private Sub txtCash_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        TbMasuk.SetFocus
    ElseIf Not (KeyAscii >= Asc(“0”) _
    And KeyAscii <= Asc(“9”) _
    Or KeyAscii = vbKeyBack) Then
        Beep
        KeyAscii = 0
    End If
End Sub

Private Sub txtJumlah_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        TbMasuk.SetFocus
    ElseIf Not (KeyAscii >= Asc(“0”) _
    And KeyAscii <= Asc(“9”) _
    Or KeyAscii = vbKeyBack) Then
        Beep
        KeyAscii = 0
    End If
End Sub

Private Sub txtKode_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
        If Len(txtKode.Text) < 5 Then
            MsgBox “NIP HARUS 5 DIGIT”, _
            vbCritical, “Error”
            Exit Sub
        End If
        KeyAscii = 0

    Set Rs_GajiPokok = New ADODB.Recordset
    Rs_GajiPokok.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.Gaji_Pokok <> 0 ” _
        & ” AND Pegawai.NIP='” & txtKode.Text & “‘ “, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic

        If Rs_GajiPokok.BOF Then
            MsgBox “NIP TIDAK DIKENALI ..”, _
            vbInformation, “Info”
        Else
            With Rs_GajiPokok
            txtGaji.Text = !Gaji_Pokok
            txtNama.Text = !Nm_Pegawai
            
            End With
        End If
    End If
End Sub

12. Buat Form untuk formCari Gaji (frmCari Gaji)

SourceCode

Option Explicit

Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
    (Screen.Height – Height) / 2

    Call BukaDatabase
    Call TampilGridData
End Sub

Sub AktifGridBarang()
    With GridBarang
        .RowHeightMin = 300
        .Col = 0
        .Row = 0
        .Text = “NO”
        .CellFontBold = True
        .ColWidth(0) = 400
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .RowHeightMin = 300
        .Col = 1
        .Row = 0
        .Text = “KODE”
        .CellFontBold = True
        .ColWidth(1) = 750
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 2
        .Row = 0
        .Text = “JENIS”
        .CellFontBold = True
        .ColWidth(2) = 1900
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 3
        .Row = 0
        .Text = “NAMA PEGAWAI”
        .CellFontBold = True
        .ColWidth(3) = 3300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 4
        .Row = 0
        .Text = “TUNJANGAN [Rp.]”
        .CellFontBold = True
        .ColWidth(4) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 5
        .Row = 0
        .Text = “GAJI POKOK [Rp.]”
        .CellFontBold = True
        .ColWidth(5) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
    End With
End Sub

Sub TampilGridData()
    Dim Baris As Integer

    GridBarang.Clear
    Call AktifGridBarang
    
        
    GridBarang.Rows = 2
    Baris = 0
    
    If Rs_GajiPokok.BOF Then
        MsgBox “Tabel Pegawai masih kosong!”, _
        vbInformation + vbOKOnly, “Informasi”
        Exit Sub
    Else
        With Rs_GajiPokok
        .MoveFirst
        Do While Not .EOF
            Baris = Baris + 1
            GridBarang.Rows = Baris + 1
            GridBarang.TextMatrix(Baris, 0) = Baris
            GridBarang.TextMatrix(Baris, 1) = !NIP
            GridBarang.TextMatrix(Baris, 2) = !Nama_Jabatan
            GridBarang.TextMatrix(Baris, 3) = !Nm_Pegawai
            GridBarang.TextMatrix(Baris, 4) = !Tunjangan
            GridBarang.TextMatrix(Baris, 5) = !Gaji_Pokok
        .MoveNext
        Loop
        End With
    End If

End Sub

Private Sub GridBarang_DblClick()
    Dim barisGrid As String
    barisGrid = GridBarang.Row

    Set Rs_GajiPokok = New ADODB.Recordset
    Rs_GajiPokok.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.NIP='” _
        & GridBarang.TextMatrix(barisGrid, 1) & “‘”, _
        KoneksiDB, adOpenDynamic, adLockOptimistic

    If GridBarang.Rows <> 1 Then
       With frmGaji
          .txtKode.Text = _
             UCase(GridBarang.TextMatrix(barisGrid, 1))
          .txtNama.Text = _
             UCase(GridBarang.TextMatrix(barisGrid, 3))
          .txtGaji.Text = _
             GridBarang.TextMatrix(barisGrid, 5)
          
       End With
    Else
        Exit Sub
    End If
    
    FrmUtama.Enabled = False
    frmGaji.Enabled = True
    Unload Me
End Sub

Private Sub TbNormal_Click()
    Call Form_Load
    txtCari.Text = “”
    txtCari.SetFocus
End Sub

Private Sub TbTutup_Click()
    FrmUtama.Enabled = False
    frmGaji.Enabled = True
    Unload Me
End Sub

Private Sub txtCari_Change()
    If Option2.Value = True Then
        
        Set Rs_GajiPokok = New ADODB.Recordset
        Rs_GajiPokok.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.Nm_Pegawai LIKE ‘%” _
        & txtCari.Text & “%’ ORDER BY NIP”, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        
        If Rs_GajiPokok.BOF Then
            MsgBox “Tidak menemukan nama Pegawai! ” _
            & ” – ” & txtCari.Text & ” – dalam tabel”, _
            vbInformation, “Informasi”
            
            txtCari.Text = “”
            txtCari.SetFocus
        Else
          Call TampilGridData
        End If

    ElseIf Option1.Value = True Then
        
        Set Rs_GajiPokok = New ADODB.Recordset
        Rs_GajiPokok.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.NIP LIKE ‘%” _
        & txtCari.Text & “%’ ORDER BY NIP”, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        
        If Rs_GajiPokok.BOF Then
            MsgBox “Tidak menemukan NIP! ” _
            & ” – ” & txtCari.Text & ” – dalam tabel”, _
            vbInformation, “Informasi”
            
            txtCari.Text = “”
            txtCari.SetFocus
        Else
            Call TampilGridData
        End If
    End If
End Sub

13. Buat form untuk form cari Pegawai (frmCariPegawai)

Orange = Option Button (pilihan), untuk merubah nama ada di kolom Caption

SourceCode
Private Sub Form_Load()
    Move (Screen.Width – Width) / 2, _
    (Screen.Height – Height) / 4

    Call BukaDatabase
    Call TampilGridData
End Sub

Sub AktifGridPegawai()
    With GridPegawai
        .RowHeightMin = 300
        .Col = 0
        .Row = 0
        .Text = “NO”
        .CellFontBold = True
        .ColWidth(0) = 400
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .RowHeightMin = 300
        .Col = 1
        .Row = 0
        .Text = “KODE”
        .CellFontBold = True
        .ColWidth(1) = 750
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 2
        .Row = 0
        .Text = “JABATAN”
        .CellFontBold = True
        .ColWidth(2) = 1900
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 3
        .Row = 0
        .Text = “NAMA PEGAWAI”
        .CellFontBold = True
        .ColWidth(3) = 3300
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 4
        .Row = 0
        .Text = “TUNJANGAN [Rp.]”
        .CellFontBold = True
        .ColWidth(4) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 5
        .Row = 0
        .Text = “GAJI”
        .CellFontBold = True
        .ColWidth(5) = 1600
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
        .Col = 6
        .Row = 0
        .Text = “KETERANGAN”
        .CellFontBold = True
        .ColWidth(6) = 3000
        .AllowUserResizing = flexResizeColumns
        .CellAlignment = flexAlignCenterCenter
        
    End With
End Sub

Sub TampilGridData()
    Dim Baris As Integer

    GridPegawai.Clear
    Call AktifGridPegawai
    
        
    GridPegawai.Rows = 2
    Baris = 0
    
    If Rs_Pegawai.BOF Then
        MsgBox “Tabel Pegawai masih kosong!”, _
        vbInformation + vbOKOnly, “Informasi”
        Exit Sub
    Else
        With Rs_Pegawai
        .MoveFirst
        Do While Not .EOF
            Baris = Baris + 1
            GridPegawai.Rows = Baris + 1
            GridPegawai.TextMatrix(Baris, 0) = Baris
            GridPegawai.TextMatrix(Baris, 1) = !NIP
            GridPegawai.TextMatrix(Baris, 2) = !Nama_Jabatan
            GridPegawai.TextMatrix(Baris, 3) = !Nm_Pegawai
            GridPegawai.TextMatrix(Baris, 4) = !Tunjangan
            GridPegawai.TextMatrix(Baris, 5) = !Gaji_Pokok
            GridPegawai.TextMatrix(Baris, 6) = UCase(!Keterangan)
        .MoveNext
        Loop
        End With
    End If
End Sub

Private Sub GridPegawai_DblClick()
    Dim barisGrid As String
    barisGrid = GridPegawai.Row
    
    frmUbahGaji.Label7.Visible = True
    frmUbahGaji.txtGajiLama.Visible = True

    If GridPegawai.Rows <> 1 Then
       With frmUbahGaji
          .txtKode.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 1))
          .txtJenis.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 2))
          .txtNama.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 3))
          .txtTunjangan.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 4))
          .txtGajiLama.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 5))
          .txtKeterangan.Text = _
            UCase(GridPegawai.TextMatrix(barisGrid, 6))
      End With
    Else
        Exit Sub
    End If
    
    FrmUtama.Enabled = False
    frmUbahGaji.Enabled = True
    Unload Me
End Sub

Private Sub TbNormal_Click()
    Call Form_Load
    txtCari.Text = “”
    txtCari.SetFocus
End Sub

Private Sub TbTutup_Click()
    FrmUtama.Enabled = False
    frmUbahGaji.Enabled = True
    Unload Me
End Sub

Private Sub txtCari_Change()
    If Option2.Value = True Then
        Set Rs_Pegawai = New ADODB.Recordset
        Rs_Pegawai.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.Nm_Pegawai LIKE ‘%” _
        & txtCari.Text & “%’ ” _
        & ” ORDER BY NIP”, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        
        If Rs_Pegawai.BOF Then
            MsgBox “Tidak menemukan nama Pegawai! ” _
            & ” – ” & txtCari.Text & ” – dalam tabel”, _
            vbInformation, “Informasi”
            
            txtCari.Text = “”
            txtCari.SetFocus
        Else
          Call TampilGridData
        End If

    ElseIf Option1.Value = True Then
        Set Rs_Pegawai = New ADODB.Recordset
        Rs_Pegawai.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.NIP LIKE ‘%” _
        & txtCari.Text & “%’ ” _
        & ” ORDER BY NIP “, _
        KoneksiDB, adOpenDynamic, adLockBatchOptimistic
        
        If Rs_Pegawai.BOF Then
            MsgBox “Tidak menemukan NIP! ” _
            & ” – ” & txtCari.Text & ” – dalam tabel”, _
            vbInformation, “Informasi”
            
            txtCari.Text = “”
            txtCari.SetFocus
        Else
            Call TampilGridData
        End If
    End If
End Sub

14. Buat Form untuk form cetak gaji (frmCetakGaji)

Biru = Rich TextBox = media cetak variabelnya (rtfLap)

Orange = Common Dialog (untuk navigasi aplikasi) variabelnya (DialogSimpan)

SourceCode

Option Explicit

Public NoNota As String

Public TotGaji As String

Public Lain (+) As String

Public Total As String

Dim rsCetak As ADODB.Recordset

Dim P As Printer

Dim HariIni As String

Dim arrHari(1 To 7) As String

Private Sub Form_Load()

    Move (Screen.Width – Width) / 2, _

    (Screen.Height – Height) / 3

    rtfLap.Locked = True

   

    arrHari(1) = “Minggu”

    arrHari(2) = “Senin”

    arrHari(3) = “Selasa”

    arrHari(4) = “Rabu”

    arrHari(5) = “Kamis”

    arrHari(6) = “Jumat”

    arrHari(7) = “Sabtu”

   

    HariIni = arrHari(Abs(Weekday(Date)))

   

    Dim i, j, JlhBsu, Baris, idx, panjang, _

        pNama As Integer

    Dim hal As String

    Dim TglKini As String

    Dim Masukan As String

    Dim Kriteria As String

    Dim fileName As String

    TglKini = Format(Date, “dd/MM/yyyy”)

  

    SQL = “”

    SQL = ” SELECT Penggajian.Tgl_Nota, ” _

        & ” Detail_Penggajian.NIP, ” _

        & ” Pegawai.Nm_Pegawai, Detail_Penggajian.Tunjangan,” _

        & ” Detail_Penggajian.Kas, ” _

        & ” Detail_Penggajian.Subtotal FROM (Penggajian  ” _

        & ” INNER JOIN Detail_Penggajian ON ” _

        & ” Penggajian.No_Nota = Detail_Penggajian.No_Nota) ” _

        & ” INNER JOIN Pegawai ON ” _

        & ” Detail_Penggajian.NIP = Pegawai.NIP” _

        & ” WHERE Penggajian.No_Nota='” & NoNota & “‘”

  

    Set rsCetak = New ADODB.Recordset

    rsCetak.Open SQL, KoneksiDB

   

     ReDim tabCetak(1)

     j = 0: JlhBsu = 0: rtfLap.Text = “”

     fileName = “Temp.txt”

    

     Open fileName For Output As #1

       rtfLap.Text = ”     CPDP Wil. DEPOK I    ” & vbCrLf & _

       ” ” & vbCrLf & _

       ” Dinas Pendapatan Daerah        ” & vbCrLf & _

       ” Jl.Merdeka Raya No.2 Sukmajaya Depok      ” & Kriteria & vbCrLf & _

       ” Ph.[021]7787528       ” & Kriteria & vbCrLf & _

       ” ” & HariIni & “, ” & TglKini & “” & vbCrLf & _

       ”                                           No Transaksi: ” & NoNota & vbCrLf & _

       ” ============================================================================” & vbCrLf & _

       ” No.  Kode    Nama                         Jumlah     Harga        Total  ” & vbCrLf & _

       ” —————————————————————————-“

       Print #1, rtfLap.Text

     Close #1

     Open fileName For Input As #1

       rtfLap.Text = Input(LOF(1), 1)

     Close #1

     i = 0: idx = 1: Baris = 0

     Do While Not rsCetak.EOF

        tabCetak(i).NIP = rsCetak.Fields(“NIP”)

        tabCetak(i).NamaPegawai = rsCetak.Fields(“Nm_Pegawai”)

        tabCetak(i).Jumlah = rsCetak.Fields(“Kas”)

        tabCetak(i).HargaSatuan = rsCetak.Fields(“Tunjangan”)

        tabCetak(i).Total = tabCetak(i).Jumlah * _

                            tabCetak(i).Tunjangan

       

        Open fileName For Output As #1

          rtfLap.SelStart = Len(rtfLap.Text)

          rtfLap.Text = rtfLap.Text & ” ” & RKanan((j + 1), “#”) & “.  ” & _

                 RKiri(tabCetak(i).NIP, “###########”) & ”  ” & _

                 RKiri(tabCetak(i).NamaPegawai, “#######################”) & ”   ” & _

                 RKanan(tabCetak(i).Jumlah, “###”) & ”  ” & _

                 RKanan(tabCetak(i).Tunjangan, “#,###,###”) & ”  ” & _

                 RKanan(tabCetak(i).Total, “#,###,###”) & “” & vbCrLf

                 Print #1, rtfLap.Text

        Close #1

        If rsCetak.EOF = True Then

           Exit Do

        End If

        j = j + 1

        Baris = Baris + 1

        JlhBsu = JlhBsu + tabCetak(i).Total

        rsCetak.MoveNext

     Loop

    

     Open fileName For Output As #1

       rtfLap.Text = rtfLap.Text & _

       ” ——————————————————————-” & vbCrLf & _

       ” Total Jenis Barang = ” & RKanan(j, “###”) & “;      Total Besar Uang = ” & _

       RKanan(JlhBsu, “###,###,###,###”) & “” & vbCrLf & _

       ” ===================================================================” & vbCrLf & _

       ”                                                Total   : ” & RKanan(TotGaji, “#,###,###,###”) & “” & vbCrLf & _

       ”                                                Bayar   : ” & RKanan(Lain (+), “#,###,###,###”) & “” & vbCrLf & _

       ”                                                Kembali : ” & RKanan(Total, “#,###,###,###”) & “” & vbCrLf & _

       ” ===================================================================” & vbCrLf & _

       ”                        ** TERIMA KASIH **                          “

       Print #1, rtfLap.Text

     Close #1

     Set rsCetak = Nothing

     rtfLap.Visible = True

     Show 1

     Exit Sub

End Sub

Private Sub TbCetak_Click()

    Dim Tanya As Integer

    On Error GoTo PrintError

      If IsPrinterInstalled = False Then

         MsgBox “Belum ada printer terinstall di” & Chr(13) & _

                “komputer Anda. Silahkan install” & Chr(13) & _

                “printer terlebih dulu!”, vbCritical, _

                “Printer Belum Diinstall”

         Exit Sub

      Else

      End If

      If rtfLap.Text = “” Then

         MsgBox “Belum ada data yang akan dicetak!” & Chr(13) & _

            “Pilih kategori laporan yang akan Anda” & Chr(13) & _

            “cetak, lalu klik menu Cetak.”, vbCritical, _

            “Data Tidak Ada”

         Exit Sub

      End If

      Printer.FontName = “Courier New”

      Printer.FontSize = “9”

      Printer.Print rtfLap.Text

      Printer.EndDoc

      If MsgBox(“Hasil cetakan sudah benar?” _

        , vbQuestion + vbYesNo, “Cetak”) = vbYes Then

      End If

      Exit Sub

     

PrintError:

    MsgBox “Kesalahan nomor: ” & Err.Number _

        & “. Keterangan: ” _

        & Err.Description & “” & Chr(13) & _

        “” & Chr(13) & _

        “Kemungkinan printer belum diaktifkan” & Chr(13) & _

        “atau kertas habis/belum dipasang!” & Chr(13) & _

        “Nyalakan printer atau pasang kertas,” & Chr(13) & _

        “lalu klik menu Cetak kembali!”, _

        vbCritical, “Printer Error”

    Exit Sub

End Sub

Private Sub TbKeluar_Click()

  Unload Me

End Sub

Private Sub TbSimpan_Click()

    On Error GoTo Batal

       With DialogSimpan

         .DialogTitle = “Simpan sebagai file…”

         .Filter = “*.txt|*.txt”

         .ShowSave

         Open .fileName For Output As #1

            Print #1, rtfLap.Text

         Close #1

       End With:   Exit Sub

Batal:

       Exit Sub

End Sub

15. Module Cetak (mdlCetak) < Variabel

SourceCode

Public Type arrCetak
   NIP As String
   NamaPegawai As String
   TanggalTerima As Date
   Jumlah As Long
   Tunjangan As Long
   Total As Long
End Type

Public tabCetak() As arrCetak

‘# Tulisan rata kiri
Function RKiri(NData, CFormat) As String
  If NData > 0 Then ‘Jika NData bilangan positif
    RKiri = Format(NData, CFormat)
    ‘RKiri = RKiri + Space(Len(CFormat) – Len(RKiri))
  Else ‘Jika NData merupakan string kosong
    RKiri = Format(NData, CFormat)
    RKiri = “” + Space(Len(CFormat) – 1)
  End If
End Function

‘# Tulisan rata kanan
Function RKanan(NData, CFormat) As String
  If NData > 0 Then ‘Jika NData bilangan positif
    RKanan = Format(NData, CFormat)
    RKanan = RKanan + Space(Len(CFormat) – Len(RKanan))
  Else ‘Jika NData merupakan bilangan nol
    RKanan = Format(NData, CFormat)
    RKanan = Space(Len(CFormat) – 1) + “0”
  End If
End Function

Public Function IsPrinterInstalled() As Boolean
On Error Resume Next
Dim strDummy As String
  strDummy = Printer.DeviceName
  If Err.Number Then
     IsPrinterInstalled = False
  Else
     IsPrinterInstalled = True
  End If
End Function

16. Module Utama (mdlUtama)

Sebagai penyambung ke database

SourceCode

Option Explicit
Public KoneksiDB As New ADODB.Connection
Public Rs_Jabatan As ADODB.Recordset
Public Rs_Pegawai As ADODB.Recordset
Public Rs_GajiPokok As ADODB.Recordset
Public Rs_Pengguna As ADODB.Recordset
Public Rs_Penggajian As ADODB.Recordset
Public Rs_CetakPenggajian As ADODB.Recordset
Public Rs_PreviewPengggajian As ADODB.Recordset
Public Rs As ADODB.Recordset

Public StrAkses As String
Public SqlInsert As String
Public SqlDelete As String
Public SqlUpdate As String
Public PenggunaID, PenggunaNm As String
Public SQL As String
Public Konfirmasi As String
Public Status As String

Public Sub BukaDatabase()
    
    StrAkses = “Provider=Microsoft.Jet.OLEDB.4.0;Persist ” _
          & “Security Info=False;Data Source=” _
          & App.Path + “\DbGaji.mdb”
    
    On Error Resume Next
    
    If KoneksiDB.State = adStateOpen Then
        KoneksiDB.Close
        Set KoneksiDB = New ADODB.Connection
        KoneksiDB.Open StrAkses
    Else
        KoneksiDB.Open StrAkses
    End If
    
    Set Rs_Jabatan = New ADODB.Recordset
    Rs_Jabatan.Open “SELECT * FROM Jabatan”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic
    
    Set Rs_Pegawai = New ADODB.Recordset
    Rs_Pegawai.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” ORDER BY NIP”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic
        
    Set Rs_GajiPokok = New ADODB.Recordset
    Rs_GajiPokok.Open “SELECT Pegawai.*, ” _
        & ” Jabatan.Nama_Jabatan ” _
        & ” FROM Pegawai, Jabatan WHERE ” _
        & ” Jabatan.Kode_Jabatan=Pegawai.Kode_Jabatan ” _
        & ” AND Pegawai.Gaji_Pokok <> 0 ” _
        & ” ORDER BY NIP”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic
        
    Set Rs_Pengguna = New ADODB.Recordset
    Rs_Pengguna.Open “SELECT * FROM Pengguna”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic
        
    Set Rs_Penggajian = New ADODB.Recordset
    Rs_Penggajian.Open “SELECT * FROM Penggajian”, _
        KoneksiDB, adOpenDynamic, _
        adLockBatchOptimistic
End Sub

Public Function TglSkrg(tgl As Date) As String
    TglSkrg = Format(Day(tgl), “00”) & “/” _
            & Format(Month(tgl), “00”) & “/” _
            & Format(Year(tgl))
End Function

17. DesignerLaporan (DELaporan)

Pilih Project > More ActiveX Designer > Data Environment atau Project >addData Environtment

Hubungkan Data Encirontment dengan  databese caranya klik kanan menu Connection > Properties atauklik icon properties

lalu isikan kolom sesuai denga nam database yang telah dibuat lau klik test connection hingga munculkotak dialog laluoke

18. Membuat Command

klik kanan connUtama lalu properies

lsikan data dari database sesuai dengan laporan yang akan dibuat

biru = nama command

ornge = jenis sumber data dari database

Kuning = nama tabel databse yang akan diambil datanya

Lalu oke

19. Membuat tampilan laporan

Project > add  Data Report

Buka DELapoaran, lakukan drag commnd ke dalam data report

Klik CmdJabata(misal) tahan > tarik dan letakkan di kolom Detail Section 1

atur tampilan hinggan menjadi sepertiini

SourceCode

Private Sub DataReport_Terminate()
    rptJenis.Refresh
    DELaporan.rscmdJabatan.Close
End Sub

Buat Laporan sesuai keinginan anda..

Selamat Mencoba 😀

sumber:
https://setyawanmartha.wordpress.com/2012/12/06/totorial-aplikasi-penggajian-visual-basic-6-0/