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
SourceCodePublic 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 databaseSourceCode
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 properieslsikan 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..
No comments:
Post a Comment