Listing Program /Program Pengkodean
1. Listing Program Menu Utama
Private Sub Anggota_Click()
frmAnggota.Show 1
End Sub
Private Sub Angsuran_Click()
frmPengembalian.Show 1
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu mnFile
End If
End Sub
Private Sub Lap1_Click()
DataReport1.Show
End Sub
Private Sub Lap3_Click()
DataReport2.Show
End Sub
Private Sub Lap5_Click()
DataReport3.Show
End Sub
Private Sub Lap6_Click()
DataReport4.Show
End Sub
Private Sub mnKel_Click()
If MsgBox("Yakin menutup program?", vbQuestion + vbYesNo, "Menutup Program") = vbYes Then
End
End If
End Sub
Private Sub mnTampil_Click()
'frmLaporan.Show 1
End Sub
Private Sub Peminjaman_Click()
frmPeminjaman.Show 1
End Sub
Private Sub Penarikan_Click()
frmTutupBuku.Show 1
End Sub
Private Sub Simpanan_Click()
frmSimpanan.Show 1
End Sub
Private Sub Timer1_Timer()
Me.Caption = Right(Me.Caption, Len(Me.Caption) - 1) + Left(Me.Caption, 1)
End Sub
Private Sub Timer2_Timer()
Dim kata As String
kata = OKE.Caption
OKE.ForeColor = RGB(255, 2555, 255) * Rnd
OKE.Caption = kata
End Sub
Private Sub Timer3_Timer()
Dim kata As String
kata = OKE2.Caption
OKE2.ForeColor = RGB(255, 255, 255) * Rnd
OKE2.Caption = kata
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Anggota"
frmAnggota.Show 1
Case "Simpanan"
frmSimpanan.Show 1
Case "Penarikan"
frmTutupBuku.Show 1
Case "Peminjaman"
frmPeminjaman.Show 1
Case "Angsuran"
frmPengembalian.Show 1
Case "Keluar"
If MsgBox("Yakin menutup program?", vbQuestion + vbYesNo, "Menutup Program") = vbYes Then
End
End If
End Select
End Sub
2. Listing Anggota
Private Sub cmdKeluar_Click()
Unload Me
End Sub
Private Sub Clear()
For Each TXT In Me.Controls
If TypeOf TXT Is TextBox Then
TXT.Text = ""
ElseIf TypeOf TXT Is ComboBox Then
TXT.ListIndex = -1
End If
Next
cboJK.Text = ""
cboGol.Text = ""
End Sub
Private Sub loadLV()
On Error Resume Next
With rsAnggota
ListView1.ListItems.Clear
Do While Not .EOF
Set j = ListView1.ListItems.Add(, , .Fields!No_Agt, , 1)
j.SubItems(1) = .Fields!NIP
j.SubItems(2) = .Fields!Nama_Agt
j.SubItems(3) = .Fields!JenKel
j.SubItems(4) = .Fields!Gol
j.SubItems(5) = .Fields!Gapok
j.SubItems(6) = .Fields!Alamat
j.SubItems(7) = .Fields!Telp
.MoveNext
Loop
End With
End Sub
Private Sub RetFields()
On Error Resume Next
With rsAnggota
Me.txtNoAgt.Text = .Fields!No_Agt
Me.txtNIP.Text = .Fields!NIP
Me.txtNm.Text = .Fields!Nama_Agt
Me.cboJK.Text = .Fields!JenKel
Me.cboGol.Text = .Fields!Gol
Me.txtGapok.Text = .Fields!Gapok
Me.txtAlamat.Text = .Fields!Alamat
Me.txtTelp.Text = .Fields!Telp
End With
End Sub
Private Sub SaveData()
Dim Saldo As Currency
Saldo = 0
SQlSimpan = "insert into Anggota(No_Agt,NIP,Nama_Agt,JenKel,Gol,Gapok,Alamat,Telp)" & _
"values('" & Me.txtNoAgt.Text & "'," & _
"'" & Me.txtNIP.Text & "'," & _
"'" & Me.txtNm.Text & "'," & _
"'" & Me.cboJK.Text & "'," & _
"'" & Me.cboGol.Text & "'," & _
"'" & Me.txtGapok.Text & "'," & _
"'" & Me.txtAlamat.Text & "'," & _
"'" & Me.txtTelp.Text & "');"
xx.Execute SQlSimpan
SQlSimpan = "insert into Saldo(No_Agt,S_Pokok,S_Wajib,S_Sukarela,Pinjaman)" & _
"values('" & Me.txtNoAgt.Text & "'," & _
"'" & Saldo & "'," & _
"'" & Saldo & "'," & _
"'" & Saldo & "'," & _
"'" & Saldo & "');"
xx.Execute SQlSimpan
End Sub
Sub UpdateData()
SQLUpdate = "update Anggota set No_Agt ='" & Trim$(Me.txtNoAgt.Text) & "'," & _
"NIP='" & Trim$(Me.txtNIP.Text) & "'," & _
"Nama_Agt='" & Trim$(Me.txtNm.Text) & "'," & _
"JenKel='" & Trim$(Me.cboJK.Text) & "'," & _
"Gol='" & Trim$(Me.cboGol.Text) & "'," & _
"Gapok='" & Trim$(Me.txtGapok.Text) & "'," & _
"Alamat='" & Trim$(Me.txtAlamat.Text) & "'," & _
"Telp='" & Trim$(Me.txtTelp.Text) & "'" & _
"where No_Agt='" & Me.txtNoAgt.Text & "'"
xx.Execute SQLUpdate
End Sub
Private Sub TidakBisaIsi()
Frame1.Enabled = False
cmdBatal.Enabled = False
cmdSimpan.Enabled = False
cmdEdit.Enabled = False
cmdHapus.Enabled = False
End Sub
Private Sub cmdBatal_Click()
cmdSimpan.Enabled = False
cmdTambah.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
ListView1.Enabled = True
Call Clear
Frame1.Enabled = False
Frame2.Enabled = True
ladd = False
ledit = False
cmdBatal.Enabled = False
cmdTambah.SetFocus
End Sub
Private Sub cmdEdit_Click()
Frame1.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdHapus.Enabled = False
cmdTambah.Enabled = False
ListView1.Enabled = True
Me.txtNoAgt.Enabled = False
Me.txtNIP.SetFocus
SendKeys "{home}+{end}"
ledit = True
End Sub
Private Sub cmdHapus_Click()
Dim reply
If rsAnggota.State = adStateOpen Then Set rsAnggota = Nothing
Set rsAnggota = New ADODB.Recordset
StrSql = "SELECT * FROM Anggota WHERE No_Agt='" & Me.txtNoAgt.Text & "'"
rsAnggota.Open StrSql, xx, adOpenDynamic, adLockOptimistic
With rsAnggota
If Not .EOF Then
reply = MsgBox("Benar mau menghapus?", vbQuestion + vbYesNo, "Menghapus data")
If reply = vbYes Then
SQLHapus = "DELETE FROM Anggota WHERE No_Agt='" & Me.txtNoAgt.Text & "'"
xx.Execute SQLHapus
SQLHapus = "DELETE FROM Saldo WHERE No_Agt='" & Me.txtNoAgt.Text & "'"
xx.Execute SQLHapus
Bar1.Visible = True
Timer1.Enabled = True
cmdBatal_Click
End If
End If
End With
If rsAnggota.State = adStateOpen Then Set rsAnggota = Nothing
Set rsAnggota = New ADODB.Recordset
StrSql = "Select * from Anggota"
rsAnggota.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsAnggota = Nothing
End Sub
Private Sub cmdTambah_Click()
Frame1.Enabled = True
Frame2.Enabled = False
cmdTambah.Enabled = False
cmdBatal.Enabled = True
cmdEdit.Enabled = False
Call Clear
txtNoAgt.Enabled = True
txtNoAgt.SetFocus
ladd = True
End Sub
Private Sub Form_Load()
Connect
Set rsAnggota = New ADODB.Recordset
rsAnggota.Open "Select * from Anggota", xx, adOpenDynamic, adLockOptimistic
Call loadLV
ledit = False
ladd = False
Call TidakBisaIsi
End Sub
Private Sub cmdSimpan_Click()
Dim strsqlsave, strsqlupdate
Dim X
If ladd Then
If Me.txtNoAgt.Text <> "" And _
Me.txtTelp.Text <> "" Then
X = Len(Me.txtNoAgt.Text)
If X <>
MsgBox "Maaf, No. Anggota harus 5 digit!", vbCritical, "Pesan"
Me.txtNoAgt.SetFocus
Exit Sub
Else
Connect
Set rsAnggota = New ADODB.Recordset
If rsAnggota.State = adStateOpen Then Set rsAnggota = Nothing
rsAnggota.Open "Select * from Anggota where No_Agt='" & Me.txtNoAgt.Text & "'", xx, adOpenDynamic, adLockOptimistic
With rsAnggota
If Not .EOF Then
PesanSudahAda frmAnggota
Me.txtNoAgt.SetFocus
SendKeys "{home}+{End}"
Exit Sub
End If
End With
Call SaveData
Bar1.Visible = True
Timer1.Enabled = True
End If
Else
PesanKosong frmAnggota
Exit Sub
End If
ElseIf ledit Then
If Me.txtTelp.Text <> "" Then
Call UpdateData
Bar1.Visible = True
Timer1.Enabled = True
Else
PesanKosong frmAnggota
Exit Sub
End If
End If
cmdBatal_Click
If rsAnggota.State = adStateOpen Then Set rsAnggota = Nothing
Set rsAnggota = New ADODB.Recordset
StrSql = "Select * from Anggota"
rsAnggota.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsAnggota = Nothing
End Sub
Private Sub Timer1_Timer()
Bar1.Value = Bar1.Value + 5
If Bar1.Value = 100 Then
Timer1.Enabled = False
Bar1.Visible = False
Bar1.Value = 0
End If
End Sub
Private Sub txtAlamat_Change()
If txtAlamat.Text <> "" Then
cmdSimpan.Enabled = True
Else
cmdSimpan.Enabled = False
End If
End Sub
Private Sub txtNoAgt_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call OpenTable("Select * from Anggota where No_Agt='" & txtNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNoAgt.Text = .Fields!No_Agt
Me.txtNIP.Text = .Fields!NIP
Me.txtNm.Text = .Fields!Nama_Agt
Me.cboJK.Text = .Fields!JenKel
Me.cboGol.Text = .Fields!Gol
Me.txtGapok.Text = .Fields!Gapok
Me.txtAlamat.Text = .Fields!Alamat
Me.txtTelp.Text = .Fields!Telp
MsgBox "Data tersebut telah ada!", vbInformation + vbOKOnly, "Pesan"
cmdEdit.Enabled = True
cmdHapus.Enabled = True
ledit = True
ladd = False
End If
txtNoAgt.SetFocus
End With
If txtNIP.Text = "" Then
txtNIP.SetFocus
ledit = False
ladd = True
Else
Exit Sub
End If
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count <> 0 Then
Set rsAnggota = New ADODB.Recordset
If rsAnggota.State = adStateOpen Then Set rsAnggota = Nothing
StrSql = "Select * from Anggota where No_Agt='" & ListView1.ListItems.Item(ListView1.SelectedItem.Index).Text & "'"
rsAnggota.Open StrSql, xx, adOpenDynamic, adLockOptimistic
If Not rsAnggota.EOF Then
Call RetFields
End If
Me.cmdHapus.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdTambah.Enabled = False
End If
End Sub
Private Sub txtTelp_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Private Sub txtGapok_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
3. Listing Simpanan
Private Sub cboNoAgt_Change()
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtSPokok.Text = .Fields!S_Pokok
Me.txtSWajib.Text = .Fields!S_Wajib
Me.txtSSukarela.Text = .Fields!S_Sukarela
End If
End With
End Sub
Private Sub cboNoAgt_Click()
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtSPokok.Text = .Fields!S_Pokok
Me.txtSWajib.Text = .Fields!S_Wajib
Me.txtSSukarela.Text = .Fields!S_Sukarela
End If
End With
End Sub
Private Sub cmdKeluar_Click()
Unload Me
End Sub
Private Sub Clear()
For Each TXT In Me.Controls
If TypeOf TXT Is TextBox Then
TXT.Text = ""
ElseIf TypeOf TXT Is ComboBox Then
TXT.ListIndex = -1
End If
Next
cboNoAgt.Text = ""
cboNmSpn.Text = ""
tgl.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub loadLV()
On Error Resume Next
With rsSimpanan
ListView1.ListItems.Clear
Do While Not .EOF
Set j = ListView1.ListItems.Add(, , .Fields!No_Spn, , 1)
j.SubItems(1) = .Fields!No_Agt
j.SubItems(2) = .Fields!Nama_Spn
j.SubItems(3) = .Fields!Tgl_Spn
j.SubItems(4) = .Fields!Jlh_Spn
.MoveNext
Loop
End With
End Sub
Private Sub RetFields()
On Error Resume Next
With rsSimpanan
Me.txtNo.Text = .Fields!No_Spn
Me.cboNoAgt.Text = .Fields!No_Agt
Me.cboNmSpn.Text = .Fields!Nama_Spn
Me.tgl.Value = .Fields!Tgl_Spn
Me.txtJlh.Text = .Fields!Jlh_Spn
End With
End Sub
Private Sub SaveData()
SQlSimpan = "insert into Simpanan(No_Spn,No_Agt,Nama_Spn,Tgl_Spn,Jlh_Spn)" & _
"values('" & Me.txtNo.Text & "'," & _
"'" & Me.cboNoAgt.Text & "'," & _
"'" & Me.cboNmSpn.Text & "'," & _
"'" & Me.tgl.Value & "'," & _
"'" & Me.txtJlh.Text & "');"
xx.Execute SQlSimpan
ladd = False
ledit = True
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"S_Pokok='" & Trim$(Me.txtSPokok.Text) & "'," & _
"S_Wajib='" & Trim$(Me.txtSWajib.Text) & "'," & _
"S_Sukarela='" & Trim$(Me.txtSSukarela.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
ledit = False
ladd = True
End Sub
Sub UpdateData()
SQLUpdate = "update Simpanan set No_Spn ='" & Trim$(Me.txtNo.Text) & "'," & _
"No_Agt='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Nama_Spn='" & Trim$(Me.cboNmSpn.Text) & "'," & _
"Tgl_Spn='" & Trim$(Me.tgl.Value) & "'," & _
"Jlh_Spn='" & Trim$(Me.txtJlh.Text) & "'" & _
"where No_Spn='" & Me.txtNo.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"S_Pokok='" & Trim$(Me.txtSPokok.Text) & "'," & _
"S_Wajib='" & Trim$(Me.txtSWajib.Text) & "'," & _
"S_Sukarela='" & Trim$(Me.txtSSukarela.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
End Sub
Private Sub TidakBisaIsi()
Frame1.Enabled = False
cmdBatal.Enabled = False
cmdSimpan.Enabled = False
cmdEdit.Enabled = False
cmdHapus.Enabled = False
End Sub
Private Sub cmdBatal_Click()
cmdSimpan.Enabled = False
cmdTambah.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
ListView1.Enabled = True
Call Clear
Frame1.Enabled = False
Frame2.Enabled = True
ladd = False
ledit = False
cmdBatal.Enabled = False
cmdTambah.SetFocus
End Sub
Private Sub cmdEdit_Click()
Frame1.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdHapus.Enabled = False
cmdTambah.Enabled = False
ListView1.Enabled = True
Me.txtNo.Enabled = False
Me.cboNoAgt.SetFocus
SendKeys "{home}+{end}"
ledit = True
End Sub
Private Sub cmdHapus_Click()
Dim reply
If rsSimpanan.State = adStateOpen Then Set rsSimpanan = Nothing
Set rsSimpanan = New ADODB.Recordset
StrSql = "SELECT * FROM Simpanan WHERE No_Spn='" & Me.txtNo.Text & "'"
rsSimpanan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
With rsSimpanan
If Not .EOF Then
reply = MsgBox("Benar mau menghapus?", vbQuestion + vbYesNo, "Menghapus data")
If reply = vbYes Then
SQLHapus = "DELETE FROM Simpanan WHERE No_Spn='" & Me.txtNo.Text & "'"
xx.Execute SQLHapus
Bar1.Visible = True
Timer1.Enabled = True
cmdBatal_Click
End If
End If
End With
If rsSimpanan.State = adStateOpen Then Set rsSimpanan = Nothing
Set rsSimpanan = New ADODB.Recordset
StrSql = "Select * from Simpanan"
rsSimpanan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsSimpanan = Nothing
End Sub
Private Sub cmdTambah_Click()
Frame1.Enabled = True
Frame2.Enabled = False
cmdTambah.Enabled = False
cmdBatal.Enabled = True
cmdEdit.Enabled = False
Call Clear
txtNo.Enabled = True
txtNo.SetFocus
ladd = True
tgl.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub Form_Load()
Connect
Set rsSimpanan = New ADODB.Recordset
rsSimpanan.Open "Select * from Simpanan", xx, adOpenDynamic, adLockOptimistic
Call LoadNoAgtToCombo("SELECT * FROM [Anggota]", rsAnggota, Me.cboNoAgt)
Call loadLV
ledit = False
ladd = False
Call TidakBisaIsi
End Sub
Private Sub cmdSimpan_Click()
Dim strsqlsave, strsqlupdate
Dim X
If ladd Then
If Me.txtNo.Text <> "" And _
Me.cboNoAgt.Text <> "" Then
X = Len(Me.txtNo.Text)
If X <>
MsgBox "Maaf, Nomor simpan minimal 1 digit!", vbCritical, "Pesan"
Me.txtNo.SetFocus
Exit Sub
Else
Connect
Set rsSimpanan = New ADODB.Recordset
If rsSimpanan.State = adStateOpen Then Set rsSimpanan = Nothing
rsSimpanan.Open "Select * from Simpanan where No_Spn='" & Me.txtNo.Text & "'", xx, adOpenDynamic, adLockOptimistic
With rsSimpanan
If Not .EOF Then
PesanSudahAda frmSimpanan
Me.txtNo.SetFocus
SendKeys "{home}+{End}"
Exit Sub
End If
End With
Call SaveData
Bar1.Visible = True
Timer1.Enabled = True
End If
Else
PesanKosong frmSimpanan
Exit Sub
End If
ElseIf ledit Then
If Me.cboNoAgt.Text <> "" Then
Call UpdateData
Bar1.Visible = True
Timer1.Enabled = True
Else
PesanKosong frmSimpanan
Exit Sub
End If
End If
cmdBatal_Click
If rsSimpanan.State = adStateOpen Then Set rsSimpanan = Nothing
Set rsSimpanan = New ADODB.Recordset
StrSql = "Select * from Simpanan"
rsSimpanan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsSimpanan = Nothing
End Sub
Private Sub Timer1_Timer()
Bar1.Value = Bar1.Value + 5
If Bar1.Value = 100 Then
Timer1.Enabled = False
Bar1.Visible = False
Bar1.Value = 0
End If
End Sub
Private Sub txtJlh_Change()
If txtJlh.Text <> "" Then
cmdSimpan.Enabled = True
Else
cmdSimpan.Enabled = False
End If
End Sub
Private Sub txtJlh_LostFocus()
If cboNmSpn.Text = "S_Sukarela" Then
txtSSukarela.Text = Val(txtSSukarela.Text) + Val(txtJlh.Text)
ElseIf cboNmSpn.Text = "S_Wajib" Then
txtSWajib.Text = Val(txtSWajib.Text) + Val(txtJlh.Text)
ElseIf cboNmSpn.Text = "S_Pokok" Then
txtSPokok.Text = txtSPokok.Text + Val(txtJlh.Text)
End If
End Sub
Private Sub txtNo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call OpenTable("Select * from Simpanan where No_Spn='" & txtNo.Text & "'", rsSimpanan)
With rsSimpanan
If Not .EOF Then
Me.txtNo.Text = .Fields!No_Spn
Me.cboNoAgt.Text = .Fields!No_Agt
Me.cboNmSpn.Text = .Fields!Nama_Spn
Me.tgl.Value = .Fields!Tgl_Spn
Me.txtJlh.Text = .Fields!Jlh_Spn
MsgBox "Data tersebut telah ada!", vbInformation + vbOKOnly, "Pesan"
cmdEdit.Enabled = True
cmdHapus.Enabled = True
ledit = True
ladd = False
End If
txtNo.SetFocus
End With
If cboNoAgt.Text = "" Then
cboNoAgt.SetFocus
ledit = False
ladd = True
Else
Exit Sub
End If
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count <> 0 Then
Set rsSimpanan = New ADODB.Recordset
If rsSimpanan.State = adStateOpen Then Set rsSimpanan = Nothing
StrSql = "Select * from Simpanan where No_Spn='" & ListView1.ListItems.Item(ListView1.SelectedItem.Index).Text & "'"
rsSimpanan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
If Not rsSimpanan.EOF Then
Call RetFields
End If
Me.cmdHapus.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdTambah.Enabled = False
End If
End Sub
Private Sub txtJlh_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
4. Listing Penarikan
Private Sub cboNoAgt_Change()
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtSPokok.Text = .Fields!S_Pokok
Me.txtSWajib.Text = .Fields!S_Wajib
Me.txtSSukarela.Text = .Fields!S_Sukarela
End If
End With
txtSaldo.Text = txtSSukarela.Text
End Sub
Private Sub cboNoAgt_Click()
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtSPokok.Text = .Fields!S_Pokok
Me.txtSWajib.Text = .Fields!S_Wajib
Me.txtSSukarela.Text = .Fields!S_Sukarela
End If
End With
txtSaldo.Text = txtSSukarela.Text
End Sub
Private Sub cmdKeluar_Click()
Unload Me
End Sub
Private Sub Clear()
For Each TXT In Me.Controls
If TypeOf TXT Is TextBox Then
TXT.Text = ""
ElseIf TypeOf TXT Is ComboBox Then
TXT.ListIndex = -1
End If
Next
cboNoAgt.Text = ""
tgl.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub loadLV()
On Error Resume Next
With rsPenarikan
ListView1.ListItems.Clear
Do While Not .EOF
Set j = ListView1.ListItems.Add(, , .Fields!No_Tarik, , 1)
j.SubItems(1) = .Fields!No_Agt
j.SubItems(2) = .Fields!Tgl_Tarik
j.SubItems(3) = .Fields!Jlh_Tarik
.MoveNext
Loop
End With
End Sub
Private Sub RetFields()
On Error Resume Next
With rsPenarikan
Me.txtNo.Text = .Fields!No_Tarik
Me.cboNoAgt.Text = .Fields!No_Agt
Me.tgl.Value = .Fields!Tgl_Tarik
Me.txtJlh.Text = .Fields!Jlh_Tarik
End With
End Sub
Private Sub SaveData()
SQlSimpan = "insert into Penarikan(No_Tarik,No_Agt,Tgl_Tarik,Jlh_Tarik)" & _
"values('" & Me.txtNo.Text & "'," & _
"'" & Me.cboNoAgt.Text & "'," & _
"'" & Me.tgl.Value & "'," & _
"'" & Me.txtJlh.Text & "');"
xx.Execute SQlSimpan
ladd = False
ledit = True
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"S_Pokok='" & Trim$(Me.txtSPokok.Text) & "'," & _
"S_Wajib='" & Trim$(Me.txtSWajib.Text) & "'," & _
"S_Sukarela='" & Trim$(Me.txtSSukarela.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
ledit = False
ladd = True
End Sub
Sub UpdateData()
SQLUpdate = "update Penarikan set No_Tarik ='" & Trim$(Me.txtNo.Text) & "'," & _
"No_Agt='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Tgl_Tarik='" & Trim$(Me.tgl.Value) & "'," & _
"Jlh_Tarik='" & Trim$(Me.txtJlh.Text) & "'" & _
"where No_Tarik='" & Me.txtNo.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"S_Pokok='" & Trim$(Me.txtSPokok.Text) & "'," & _
"S_Wajib='" & Trim$(Me.txtSWajib.Text) & "'," & _
"S_Sukarela='" & Trim$(Me.txtSSukarela.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
End Sub
Private Sub TidakBisaIsi()
Frame1.Enabled = False
cmdBatal.Enabled = False
cmdSimpan.Enabled = False
cmdEdit.Enabled = False
cmdHapus.Enabled = False
End Sub
Private Sub cmdBatal_Click()
cmdSimpan.Enabled = False
cmdTambah.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
ListView1.Enabled = True
Call Clear
Frame1.Enabled = False
Frame2.Enabled = True
ladd = False
ledit = False
cmdBatal.Enabled = False
cmdTambah.SetFocus
End Sub
Private Sub cmdEdit_Click()
Frame1.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdHapus.Enabled = False
cmdTambah.Enabled = False
ListView1.Enabled = True
Me.txtNo.Enabled = False
Me.cboNoAgt.SetFocus
SendKeys "{home}+{end}"
ledit = True
End Sub
Private Sub cmdHapus_Click()
Dim reply
If rsPenarikan.State = adStateOpen Then Set rsPenarikan = Nothing
Set rsPenarikan = New ADODB.Recordset
StrSql = "SELECT * FROM Penarikan WHERE No_Tarik='" & Me.txtNo.Text & "'"
rsPenarikan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
With rsPenarikan
If Not .EOF Then
reply = MsgBox("Benar mau menghapus?", vbQuestion + vbYesNo, "Menghapus data")
If reply = vbYes Then
SQLHapus = "DELETE FROM Penarikan WHERE No_Tarik='" & Me.txtNo.Text & "'"
xx.Execute SQLHapus
Bar1.Visible = True
Timer1.Enabled = True
cmdBatal_Click
End If
End If
End With
If rsPenarikan.State = adStateOpen Then Set rsPenarikan = Nothing
Set rsPenarikan = New ADODB.Recordset
StrSql = "Select * from Penarikan"
rsPenarikan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsPenarikan = Nothing
End Sub
Private Sub cmdTambah_Click()
Frame1.Enabled = True
Frame2.Enabled = False
cmdTambah.Enabled = False
cmdBatal.Enabled = True
cmdEdit.Enabled = False
Call Clear
txtNo.Enabled = True
txtNo.SetFocus
ladd = True
tgl.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub Form_Load()
Connect
Set rsPenarikan = New ADODB.Recordset
rsPenarikan.Open "Select * from Penarikan", xx, adOpenDynamic, adLockOptimistic
Call LoadNoAgtToCombo("SELECT * FROM [Anggota]", rsAnggota, Me.cboNoAgt)
Call loadLV
ledit = False
ladd = False
Call TidakBisaIsi
End Sub
Private Sub cmdSimpan_Click()
txtSaldo.Text = Val(txtSaldo.Text) - Val(txtJlh.Text)
Dim strsqlsave, strsqlupdate
Dim X
If ladd Then
If Me.txtNo.Text <> "" And _
Me.cboNoAgt.Text <> "" Then
X = Len(Me.txtNo.Text)
If X <>
MsgBox "Maaf, Kode Penarikan harus 4 digit!", vbCritical, "Pesan"
Me.txtNo.SetFocus
Exit Sub
Else
Connect
Set rsPenarikan = New ADODB.Recordset
If rsPenarikan.State = adStateOpen Then Set rsPenarikan = Nothing
rsPenarikan.Open "Select * from Penarikan where No_Tarik='" & Me.txtNo.Text & "'", xx, adOpenDynamic, adLockOptimistic
With rsPenarikan
If Not .EOF Then
PesanSudahAda frmPenarikan
Me.txtNo.SetFocus
SendKeys "{home}+{End}"
Exit Sub
End If
End With
Call SaveData
Bar1.Visible = True
Timer1.Enabled = True
End If
Else
PesanKosong frmPenarikan
Exit Sub
End If
ElseIf ledit Then
If Me.cboNoAgt.Text <> "" Then
Call UpdateData
Bar1.Visible = True
Timer1.Enabled = True
Else
PesanKosong frmPenarikan
Exit Sub
End If
End If
cmdBatal_Click
If rsPenarikan.State = adStateOpen Then Set rsPenarikan = Nothing
Set rsPenarikan = New ADODB.Recordset
StrSql = "Select * from Penarikan"
rsPenarikan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsPenarikan = Nothing
End Sub
Private Sub Timer1_Timer()
Bar1.Value = Bar1.Value + 5
If Bar1.Value = 100 Then
Timer1.Enabled = False
Bar1.Visible = False
Bar1.Value = 0
End If
End Sub
Private Sub txtJlh_Change()
If ladd = True Then
If Val(txtSaldo.Text) <>
MsgBox "Maaf, Jumlah penarikan masih lebih besar dari jumlah simpanan!", vbInformation + vbOKOnly
txtJlh.SetFocus
SendKeys "{home}+{end}"
End If
End If
If txtJlh.Text <> "" Then
cmdSimpan.Enabled = True
Else
cmdSimpan.Enabled = False
End If
End Sub
Private Sub txtJlh_LostFocus()
txtSSukarela.Text = Val(txtSSukarela.Text) - Val(txtJlh.Text)
End Sub
Private Sub txtNo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call OpenTable("Select * from Penarikan where No_Tarik='" & txtNo.Text & "'", rsPenarikan)
With rsPenarikan
If Not .EOF Then
Me.txtNo.Text = .Fields!No_Tarik
Me.cboNoAgt.Text = .Fields!No_Agt
Me.tgl.Value = .Fields!Tgl_Tarik
Me.txtJlh.Text = .Fields!Jlh_Tarik
MsgBox "Data tersebut telah ada!", vbInformation + vbOKOnly, "Pesan"
cmdEdit.Enabled = True
cmdHapus.Enabled = True
ledit = True
ladd = False
End If
txtNo.SetFocus
End With
If cboNoAgt.Text = "" Then
cboNoAgt.SetFocus
ledit = False
ladd = True
Else
Exit Sub
End If
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count <> 0 Then
Set rsPenarikan = New ADODB.Recordset
If rsPenarikan.State = adStateOpen Then Set rsPenarikan = Nothing
StrSql = "Select * from Penarikan where No_Tarik='" & ListView1.ListItems.Item(ListView1.SelectedItem.Index).Text & "'"
rsPenarikan.Open StrSql, xx, adOpenDynamic, adLockOptimistic
If Not rsPenarikan.EOF Then
Call RetFields
End If
Me.cmdHapus.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdTambah.Enabled = False
ledit = True
End If
End Sub
Private Sub txtJlh_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
5. Listing Peminjaman
Private Sub cboNoAgt_Change()
Dim A1, A2, A3 As Currency
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
Me.txtGapok.Text = .Fields!Gapok
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
A1 = .Fields!S_Pokok
A2 = .Fields!S_Wajib
A3 = .Fields!S_Sukarela
txtSaldo.Text = A1 + A2 + A3
Me.txtPinjaman.Text = .Fields!Pinjaman
End If
End With
End Sub
Private Sub cboNoAgt_Click()
Dim A1, A2, A3 As Currency
Call OpenTable("Select * from Anggota where No_Agt='" & cboNoAgt.Text & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
Me.txtNmAgt.Text = .Fields!Nama_Agt
Me.txtGapok.Text = .Fields!Gapok
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & cboNoAgt.Text & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
A1 = .Fields!S_Pokok
A2 = .Fields!S_Wajib
A3 = .Fields!S_Sukarela
txtSaldo.Text = A1 + A2 + A3
Me.txtPinjaman.Text = .Fields!Pinjaman
End If
End With
If Val(txtPinjaman.Text) > 0 Then
MsgBox "Maaf, No. Anggota : " & cboNoAgt.Text & " masih mempunyai sisa angsuran yg harus dibayar!", vbInformation + vbOKOnly, "Belum diizinkan meminjam"
cboNoAgt.Text = ""
SendKeys "{home}+{end}"
txtNmAgt.Text = ""
txtGapok.Text = ""
txtSaldo.Text = ""
Else
Exit Sub
End If
End Sub
Private Sub cmdKeluar_Click()
Unload Me
End Sub
Private Sub Clear()
For Each TXT In Me.Controls
If TypeOf TXT Is TextBox Then
TXT.Text = ""
ElseIf TypeOf TXT Is ComboBox Then
TXT.ListIndex = -1
End If
Next
cboNoAgt.Text = ""
txtPinjaman.Text = 0
tgl.Value = Format(Date, "dd/mm/yyyy")
tglJT.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub loadLV()
On Error Resume Next
With rsPinjaman
ListView1.ListItems.Clear
Do While Not .EOF
Set j = ListView1.ListItems.Add(, , .Fields!No_Pjm, , 1)
j.SubItems(1) = .Fields!No_Agt
j.SubItems(2) = .Fields!Tgl_Pjm
j.SubItems(3) = .Fields!Jlh_Pjm
j.SubItems(4) = .Fields!Lama_Pjm
j.SubItems(5) = .Fields!Bunga
j.SubItems(6) = .Fields!Angsuran
.MoveNext
Loop
End With
End Sub
Private Sub RetFields()
On Error Resume Next
With rsPinjaman
Me.txtNo.Text = .Fields!No_Pjm
Me.cboNoAgt.Text = .Fields!No_Agt
Me.tgl.Value = .Fields!Tgl_Pjm
Me.txtJlh.Text = .Fields!Jlh_Pjm
Me.txtLama.Text = .Fields!Lama_Pjm
Me.txtBunga.Text = .Fields!Bunga
Me.txtAngsuran.Text = .Fields!Angsuran
Me.tglJT.Value = .Fields!Tgl_JT
End With
End Sub
Private Sub SaveData()
SQlSimpan = "insert into Pinjaman(No_Pjm,No_Agt,Tgl_Pjm,Jlh_Pjm,Lama_Pjm,Bunga,Angsuran,Tgl_JT)" & _
"values('" & Me.txtNo.Text & "'," & _
"'" & Me.cboNoAgt.Text & "'," & _
"'" & Me.tgl.Value & "'," & _
"'" & Me.txtJlh.Text & "'," & _
"'" & Me.txtLama.Text & "'," & _
"'" & Me.txtBunga.Text & "'," & _
"'" & Me.txtAngsuran.Text & "'," & _
"'" & Me.tglJT.Value & "');"
xx.Execute SQlSimpan
ladd = False
ledit = True
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Pinjaman='" & Trim$(Me.txtJlh.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
ledit = False
ladd = True
End Sub
Sub UpdateData()
SQLUpdate = "update Pinjaman set No_Pjm ='" & Trim$(Me.txtNo.Text) & "'," & _
"No_Agt='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Tgl_Pjm='" & Trim$(Me.tgl.Value) & "'," & _
"Jlh_Pjm='" & Trim$(Me.txtJlh.Text) & "'," & _
"Lama_Pjm='" & Trim$(Me.txtLama.Text) & "'," & _
"Bunga='" & Trim$(Me.txtBunga.Text) & "'," & _
"Angsuran='" & Trim$(Me.txtAngsuran.Text) & "'," & _
"Tgl_JT='" & Trim$(Me.tglJT.Value) & "'" & _
"where No_Pjm='" & Me.txtNo.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Pinjaman='" & Trim$(Me.txtJlh.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
End Sub
Private Sub TidakBisaIsi()
Frame1.Enabled = False
cmdBatal.Enabled = False
cmdSimpan.Enabled = False
cmdEdit.Enabled = False
cmdHapus.Enabled = False
End Sub
Private Sub cmdBatal_Click()
cmdSimpan.Enabled = False
cmdTambah.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
ListView1.Enabled = True
Call Clear
Frame1.Enabled = False
Frame2.Enabled = True
ladd = False
ledit = False
cmdBatal.Enabled = False
cmdTambah.SetFocus
End Sub
Private Sub cmdEdit_Click()
Frame1.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdHapus.Enabled = False
cmdTambah.Enabled = False
ListView1.Enabled = True
Me.txtNo.Enabled = False
Me.cboNoAgt.SetFocus
SendKeys "{home}+{end}"
ledit = True
txtPinjaman.Text = Val(txtPinjaman.Text) - Val(txtJlh.Text)
End Sub
Private Sub cmdHapus_Click()
txtSaldo.Text = Val(txtPinjaman.Text) - Val(txtJlh.Text)
Dim reply
If rsPinjaman.State = adStateOpen Then Set rsPinjaman = Nothing
Set rsPinjaman = New ADODB.Recordset
StrSql = "SELECT * FROM Pinjaman WHERE No_Pjm='" & Me.txtNo.Text & "'"
rsPinjaman.Open StrSql, xx, adOpenDynamic, adLockOptimistic
With rsPinjaman
If Not .EOF Then
reply = MsgBox("Benar mau menghapus?", vbQuestion + vbYesNo, "Menghapus data")
If reply = vbYes Then
ladd = False
ledit = True
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.cboNoAgt.Text) & "'," & _
"Pinjaman='" & Trim$(Me.txtPinjaman.Text) & "'" & _
"where No_Agt='" & Me.cboNoAgt.Text & "'"
xx.Execute SQLUpdate
ledit = False
ladd = True
SQLHapus = "DELETE FROM Pinjaman WHERE No_Pjm='" & Me.txtNo.Text & "'"
xx.Execute SQLHapus
Bar1.Visible = True
Timer1.Enabled = True
cmdBatal_Click
End If
End If
End With
If rsPinjaman.State = adStateOpen Then Set rsPinjaman = Nothing
Set rsPinjaman = New ADODB.Recordset
StrSql = "Select * from Pinjaman"
rsPinjaman.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsPinjaman = Nothing
End Sub
Private Sub cmdTambah_Click()
Frame1.Enabled = True
Frame2.Enabled = False
cmdTambah.Enabled = False
cmdBatal.Enabled = True
cmdEdit.Enabled = False
Call Clear
txtNo.Enabled = True
txtNo.SetFocus
ladd = True
tgl.Value = Format(Date, "dd/mm/yyyy")
tglJT.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub Form_Load()
Connect
Set rsPinjaman = New ADODB.Recordset
rsPinjaman.Open "Select * from Pinjaman", xx, adOpenDynamic, adLockOptimistic
Call LoadNoAgtToCombo("SELECT * FROM [Anggota]", rsAnggota, Me.cboNoAgt)
Call loadLV
ledit = False
ladd = False
Call TidakBisaIsi
tgl.Value = Format(Date, "dd/mm/yyyy")
tglJT.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub cmdSimpan_Click()
txtSaldo.Text = Val(txtSaldo.Text) - Val(txtJlh.Text)
Dim strsqlsave, strsqlupdate
Dim X
If ladd Then
If Me.txtNo.Text <> "" And _
Me.cboNoAgt.Text <> "" Then
X = Len(Me.txtNo.Text)
If X <>
MsgBox "Maaf, Kode Pinjaman harus 4 digit!", vbCritical, "Pesan"
Me.txtNo.SetFocus
Exit Sub
Else
Connect
Set rsPinjaman = New ADODB.Recordset
If rsPinjaman.State = adStateOpen Then Set rsPinjaman = Nothing
rsPinjaman.Open "Select * from Pinjaman where No_Pjm='" & Me.txtNo.Text & "'", xx, adOpenDynamic, adLockOptimistic
With rsPinjaman
If Not .EOF Then
PesanSudahAda frmPeminjaman
Me.txtNo.SetFocus
SendKeys "{home}+{End}"
Exit Sub
End If
End With
Call SaveData
Bar1.Visible = True
Timer1.Enabled = True
End If
Else
PesanKosong frmPeminjaman
Exit Sub
End If
ElseIf ledit Then
If Me.cboNoAgt.Text <> "" Then
Call UpdateData
Bar1.Visible = True
Timer1.Enabled = True
Else
PesanKosong frmPeminjaman
Exit Sub
End If
End If
cmdBatal_Click
If rsPinjaman.State = adStateOpen Then Set rsPinjaman = Nothing
Set rsPinjaman = New ADODB.Recordset
StrSql = "Select * from Pinjaman"
rsPinjaman.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsPinjaman = Nothing
End Sub
Private Sub Timer1_Timer()
Bar1.Value = Bar1.Value + 5
If Bar1.Value = 100 Then
Timer1.Enabled = False
Bar1.Visible = False
Bar1.Value = 0
End If
End Sub
Private Sub txtJlh_Change()
If txtJlh.Text <> "" Then
cmdSimpan.Enabled = True
Else
cmdSimpan.Enabled = False
End If
End Sub
Private Sub txtJlh_LostFocus()
If Val(txtJlh.Text) > 10000000 Then
MsgBox "Maaf, jumlah maksimal pinjaman hanya Rp 10000000", vbInformation + vbOKOnly, "Pesan"
txtJlh.SetFocus
ElseIf Val(txtJlh.Text) <>
MsgBox "Maaf, jumlah minimal pinjaman hanya Rp 700000", vbInformation + vbOKOnly, "Pesan"
Exit Sub
txtJlh.SetFocus
End If
txtBunga.Text = Val(txtJlh.Text) * 0.01
End Sub
Private Sub txtLama_LostFocus()
txtAngsuran.Text = (Val(txtJlh.Text) / Val(txtLama.Text)) + Val(txtBunga.Text)
End Sub
Private Sub txtNo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call OpenTable("Select * from Pinjaman where No_Pjm='" & txtNo.Text & "'", rsPinjaman)
With rsPinjaman
If Not .EOF Then
Me.txtNo.Text = .Fields!No_Pjm
Me.cboNoAgt.Text = .Fields!No_Agt
Me.tgl.Value = .Fields!Tgl_Pjm
Me.txtJlh.Text = .Fields!Jlh_Pjm
Me.txtLama.Text = .Fields!Lama_Pjm
Me.txtBunga.Text = .Fields!Bunga
Me.txtAngsuran.Text = .Fields!Angsuran
Me.tglJT.Value = .Fields!Tgl_JT
MsgBox "Data tersebut telah ada!", vbInformation + vbOKOnly, "Pesan"
cmdEdit.Enabled = True
cmdHapus.Enabled = True
ledit = True
ladd = False
End If
txtNo.SetFocus
End With
If cboNoAgt.Text = "" Then
cboNoAgt.SetFocus
ledit = False
ladd = True
Else
Exit Sub
End If
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count <> 0 Then
Set rsPinjaman = New ADODB.Recordset
If rsPinjaman.State = adStateOpen Then Set rsPinjaman = Nothing
StrSql = "Select * from Pinjaman where No_Pjm='" & ListView1.ListItems.Item(ListView1.SelectedItem.Index).Text & "'"
rsPinjaman.Open StrSql, xx, adOpenDynamic, adLockOptimistic
If Not rsPinjaman.EOF Then
Call RetFields
End If
Me.cmdHapus.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdTambah.Enabled = False
End If
End Sub
Private Sub txtJlh_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Private Sub txtLama_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
6. Listing Angsuran
Function SelisihHariJam(ByVal Awal As Date, _
ByVal Akhir As Date) As String
Dim Hari As Long, Jam As Long
Dim JamLengkap As String
If Awal > Akhir Then
Exit Function
End If
Detik = DateDiff("s", Awal, Akhir)
Jam = Detik \ 3600
If Jam > 23 Then
Hari = Jam \ 24
JamLengkap = Format((Akhir - Awal))
Else
Hari = 0
JamLengkap = Format((Akhir - Awal))
End If
If Hari = 0 Then
SelisihHariJam = JamLengkap
Else
SelisihHariJam = Hari
End If
Exit Function
End Function
Private Sub cboNoPjm_Change()
Call OpenTable("Select * from Pinjaman where No_Pjm='" & cboNoPjm.Text & "'", rsPinjaman)
With rsPinjaman
If Not .EOF Then
zzz = .Fields!No_Agt
txtJT.Text = .Fields!Tgl_JT
txtJlh.Text = .Fields!Angsuran
End If
End With
Call OpenTable("Select * from Anggota where No_Agt='" & zzz & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
txtNoAnggota.Text = .Fields!No_Agt
txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & zzz & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtPinjaman.Text = .Fields!Pinjaman
End If
End With
End Sub
Private Sub cboNoPjm_Click()
Call OpenTable("Select * from Pinjaman where No_Pjm='" & cboNoPjm.Text & "'", rsPinjaman)
With rsPinjaman
If Not .EOF Then
zzz = .Fields!No_Agt
txtJT.Text = .Fields!Tgl_JT
txtJlh.Text = .Fields!Angsuran
End If
End With
Call OpenTable("Select * from Anggota where No_Agt='" & zzz & "'", rsAnggota)
With rsAnggota
If Not .EOF Then
txtNoAnggota.Text = .Fields!No_Agt
txtNmAgt.Text = .Fields!Nama_Agt
End If
End With
Call OpenTable("Select * from Saldo where No_Agt='" & zzz & "'", rsSaldo)
With rsSaldo
If Not .EOF Then
Me.txtPinjaman.Text = .Fields!Pinjaman
End If
End With
End Sub
Private Sub cmdKeluar_Click()
Unload Me
End Sub
Private Sub Clear()
For Each TXT In Me.Controls
If TypeOf TXT Is TextBox Then
TXT.Text = ""
ElseIf TypeOf TXT Is ComboBox Then
TXT.ListIndex = -1
End If
Next
cboNoPjm.Text = ""
tgl.Value = Format(Date, "dd/mm/yyyy")
txtJlhByr.Text = ""
End Sub
Private Sub loadLV()
On Error Resume Next
With rsAngsuran
ListView1.ListItems.Clear
Do While Not .EOF
Set j = ListView1.ListItems.Add(, , .Fields!No_Agsr, , 1)
j.SubItems(1) = .Fields!Tgl_Agsr
j.SubItems(2) = .Fields!No_Pjm
j.SubItems(3) = .Fields!Jlh_Byr
j.SubItems(4) = .Fields!Denda
j.SubItems(5) = .Fields!Sisa_Agsr
.MoveNext
Loop
End With
End Sub
Private Sub RetFields()
On Error Resume Next
With rsAngsuran
Me.txtNo.Text = .Fields!No_Agsr
Me.tgl.Value = .Fields!Tgl_Agsr
Me.cboNoPjm.Text = .Fields!No_Pjm
Me.txtJlh.Text = .Fields!Jlh_Byr
Me.txtDenda.Text = .Fields!Denda
Me.txtPinjaman.Text = .Fields!Sisa_Agsr
End With
End Sub
Private Sub SaveData()
SQlSimpan = "insert into Angsuran(No_Agsr,Tgl_Agsr,No_Pjm,Jlh_Byr,Denda,Sisa_Agsr)" & _
"values('" & Me.txtNo.Text & "'," & _
"'" & Me.tgl.Value & "'," & _
"'" & Me.cboNoPjm.Text & "'," & _
"'" & Me.txtJlhByr.Text & "'," & _
"'" & Me.txtDenda.Text & "'," & _
"'" & Me.txtSisa.Text & "');"
xx.Execute SQlSimpan
ladd = False
ledit = True
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.txtNoAnggota.Text) & "'," & _
"Pinjaman='" & Trim$(Me.txtSisa.Text) & "'" & _
"where No_Agt='" & Me.txtNoAnggota.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Pinjaman set No_Pjm ='" & Trim$(Me.cboNoPjm.Text) & "'," & _
"Tgl_JT='" & Trim$(Me.tglJT.Value) & "'" & _
"where No_Pjm='" & Me.cboNoPjm.Text & "'"
xx.Execute SQLUpdate
ledit = False
ladd = True
End Sub
Sub UpdateData()
SQLUpdate = "update Angsuran set No_Agsr ='" & Trim$(Me.txtNo.Text) & "'," & _
"Tgl_Agsr='" & Trim$(Me.tgl.Value) & "'," & _
"No_Pjm='" & Trim$(Me.cboNoPjm.Text) & "'," & _
"Jlh_Byr='" & Trim$(Me.txtJlh.Text) & "'" & _
"Denda='" & Trim$(Me.txtDenda.Text) & "'," & _
"Sisa_Agsr='" & Trim$(Me.txtSisa.Text) & "'" & _
"where No_Agsr='" & Me.txtNo.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Saldo set No_Agt ='" & Trim$(Me.txtNoAnggota.Text) & "'," & _
"Pinjaman='" & Trim$(Me.txtSisa.Text) & "'" & _
"where No_Agt='" & Me.txtNoAnggota.Text & "'"
xx.Execute SQLUpdate
SQLUpdate = "update Pinjaman set No_Pjm ='" & Trim$(Me.cboNoPjm.Text) & "'," & _
"Tgl_JT='" & Trim$(Me.tglJT.Value) & "'" & _
"where No_Pjm='" & Me.cboNoPjm.Text & "'"
xx.Execute SQLUpdate
End Sub
Private Sub TidakBisaIsi()
Frame1.Enabled = False
cmdBatal.Enabled = False
cmdSimpan.Enabled = False
cmdEdit.Enabled = False
cmdHapus.Enabled = False
End Sub
Private Sub cmdBatal_Click()
cmdSimpan.Enabled = False
cmdTambah.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
ListView1.Enabled = True
Call Clear
Frame1.Enabled = False
Frame2.Enabled = True
ladd = False
ledit = False
cmdBatal.Enabled = False
cmdTambah.SetFocus
End Sub
Private Sub cmdEdit_Click()
Frame1.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdHapus.Enabled = False
cmdTambah.Enabled = False
ListView1.Enabled = True
Me.txtNo.Enabled = False
Me.cboNoPjm.SetFocus
SendKeys "{home}+{end}"
ledit = True
End Sub
Private Sub cmdHapus_Click()
Dim reply
If rsAngsuran.State = adStateOpen Then Set rsAngsuran = Nothing
Set rsAngsuran = New ADODB.Recordset
StrSql = "SELECT * FROM Angsuran WHERE No_Agsr='" & Me.txtNo.Text & "'"
rsAngsuran.Open StrSql, xx, adOpenDynamic, adLockOptimistic
With rsAngsuran
If Not .EOF Then
reply = MsgBox("Benar mau menghapus?", vbQuestion + vbYesNo, "Menghapus data")
If reply = vbYes Then
SQLHapus = "DELETE FROM Angsuran WHERE No_Agsr='" & Me.txtNo.Text & "'"
xx.Execute SQLHapus
Bar1.Visible = True
Timer1.Enabled = True
cmdBatal_Click
End If
End If
End With
If rsAngsuran.State = adStateOpen Then Set rsAngsuran = Nothing
Set rsAngsuran = New ADODB.Recordset
StrSql = "Select * from Angsuran"
rsAngsuran.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsAngsuran = Nothing
End Sub
Private Sub cmdTambah_Click()
Frame1.Enabled = True
Frame2.Enabled = False
cmdTambah.Enabled = False
cmdBatal.Enabled = True
cmdEdit.Enabled = False
Call Clear
txtNo.Enabled = True
txtNo.SetFocus
ladd = True
tgl.Value = Format(Date, "dd/mm/yyyy")
txtTglByr.Text = tgl.Value
End Sub
Private Sub Command1_Click()
txtDenda.Text = (Val(txtJlh.Text) * 0.02) * Val(txtLama.Text)
txtSisa.Text = Val(txtPinjaman.Text) - Val(txtJlhByr.Text)
Command1.Enabled = False
End Sub
Private Sub Form_Load()
Connect
Set rsAngsuran = New ADODB.Recordset
rsAngsuran.Open "Select * from Angsuran", xx, adOpenDynamic, adLockOptimistic
Call LoadNoPjmToCombo("SELECT * FROM [Pinjaman]", rsPinjaman, Me.cboNoPjm)
Call loadLV
ledit = False
ladd = False
Call TidakBisaIsi
tgl.Value = Format(Date, "dd/mm/yyyy")
End Sub
Private Sub cmdSimpan_Click()
Dim strsqlsave, strsqlupdate
Dim X
If ladd Then
If Me.txtNo.Text <> "" And _
Me.cboNoPjm.Text <> "" Then
X = Len(Me.txtNo.Text)
If X <>
MsgBox "Maaf, Nomor Angsuran harus 1 digit!", vbCritical, "Pesan"
Me.txtNo.SetFocus
Exit Sub
Else
Connect
Set rsAngsuran = New ADODB.Recordset
If rsAngsuran.State = adStateOpen Then Set rsAngsuran = Nothing
rsAngsuran.Open "Select * from Angsuran where No_Agsr='" & Me.txtNo.Text & "'", xx, adOpenDynamic, adLockOptimistic
With rsAngsuran
If Not .EOF Then
PesanSudahAda frmAngsuran
Me.txtNo.SetFocus
SendKeys "{home}+{End}"
Exit Sub
End If
End With
Call SaveData
Bar1.Visible = True
Timer1.Enabled = True
End If
Else
PesanKosong frmAngsuran
Exit Sub
End If
ElseIf ledit Then
If Me.cboNoPjm.Text <> "" Then
Call UpdateData
Bar1.Visible = True
Timer1.Enabled = True
Else
PesanKosong frmAngsuran
Exit Sub
End If
End If
cmdBatal_Click
If rsAngsuran.State = adStateOpen Then Set rsAngsuran = Nothing
Set rsAngsuran = New ADODB.Recordset
StrSql = "Select * from Angsuran"
rsAngsuran.Open StrSql, xx, adOpenDynamic, adLockOptimistic
loadLV
Set rsAngsuran = Nothing
End Sub
Private Sub tgl_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
txtTglByr.Text = tgl.Value
End Sub
Private Sub tgl_Change()
txtTglByr.Text = tgl.Value
End Sub
Private Sub tgl_Click()
txtTglByr.Text = tgl.Value
End Sub
Private Sub Timer1_Timer()
Bar1.Value = Bar1.Value + 5
If Bar1.Value = 100 Then
Timer1.Enabled = False
Bar1.Visible = False
Bar1.Value = 0
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
txtLama.Text = SelisihHariJam(CDate(txtJT.Text), _
CDate(txtTglByr.Text))
Exit Sub
End Sub
Private Sub txtDenda_Change()
txtJlhByr.Text = Val(txtDenda.Text) + Val(txtJlh.Text)
End Sub
Private Sub txtJlh_Change()
If txtJlh.Text <> "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub txtJT_Change()
Timer2.Enabled = False
Timer2.Interval = 500
Timer2.Enabled = True
End Sub
Private Sub txtNo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call OpenTable("Select * from Angsuran where No_Agsr='" & txtNo.Text & "'", rsAngsuran)
With rsAngsuran
If Not .EOF Then
Me.txtNo.Text = .Fields!No_Agsr
Me.tgl.Value = .Fields!Tgl_Agsr
Me.cboNoPjm.Text = .Fields!No_Pjm
Me.txtJlh.Text = .Fields!Jlh_Byr
Me.txtDenda.Text = .Fields!Denda
Me.txtPinjaman.Text = .Fields!Sisa_Agsr
MsgBox "Data tersebut telah ada!", vbInformation + vbOKOnly, "Pesan"
cmdEdit.Enabled = True
cmdHapus.Enabled = True
ledit = True
ladd = False
End If
txtNo.SetFocus
End With
If cboNoPjm.Text = "" Then
cboNoPjm.SetFocus
ledit = False
ladd = True
Else
Exit Sub
End If
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count <> 0 Then
Set rsAngsuran = New ADODB.Recordset
If rsAngsuran.State = adStateOpen Then Set rsAngsuran = Nothing
StrSql = "Select * from Angsuran where No_Agsr='" & ListView1.ListItems.Item(ListView1.SelectedItem.Index).Text & "'"
rsAngsuran.Open StrSql, xx, adOpenDynamic, adLockOptimistic
If Not rsAngsuran.EOF Then
Call RetFields
End If
Me.cmdHapus.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdTambah.Enabled = False
End If
End Sub
Private Sub txtJlh_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Private Sub txtSisa_Change()
If txtSisa.Text <> "" Then
cmdSimpan.Enabled = True
Else
cmdSimpan.Enabled = False
End If
End Sub
0 komentar:
Post a Comment