Alhamdulillah wasyukurilah Kerja Praktek saya terselesaikan,,,
biar tidak mubajir saya akan mencoba membagikan program dengan laporan menggunakan AR... buat anda yang ingin mendapatkanya hubungi email saya trimakasih...
berikut tampilanya...
TAMPILAN UTAMA PROGRAM
TAMPILAN LOGIN
TAMPILAN INPUT DATA SISWA
TAMPIALAN PEMBAYARAN
CETAK LAPORAN
Selain itu ada backup dan restore database, user management,input kelas beserta total bayar...
berikut penggalan source program pembayaran
Private Sub cmbbln_Click()
If cmbbln <> vbnullStrings Then
txtket.Text = "LUNAS"
Else
txtket.Text = "BELUM LUNAS"
End If
End Sub
Private Sub BukaKunci()
DTPicker1.Enabled = True
txtnis.Enabled = True
txtjml.Enabled = True
txtkelas.Enabled = True
' txtket.Enabled = True
txtnama.Enabled = True
txtno_byr.Enabled = True
' cmbbln.Enabled = True
End Sub
Private Sub kunci()
DTPicker1.Enabled = False
txtnis.Enabled = False
txtjml.Enabled = False
txtkelas.Enabled = False
' txtket.Enabled = False
txtnama.Enabled = False
txtno_byr.Enabled = False
' cmbbln.Enabled = False
End Sub
Private Sub cmdbatal_Click()
txtnis.Text = ""
txtjml.Text = ""
txtkelas.Text = ""
' txtket.Text = ""
txtnama.Text = ""
txtno_byr.Text = ""
' cmbbln.Text = ""
otomatis
Picture2.Visible = False
For i = 0 To 11
chkbulan(i).Enabled = False
Next i
kunci
End Sub
Private Sub cmdcari_Click()
Picture2.Visible = True
End Sub
Private Sub cmdkeluar_Click()
Unload Me
menuutama.Show
End Sub
Private Sub cmdsimpan_Click()
'On Error GoTo hell
Dim tampung As String
Dim i As Integer, s As Integer
Dim uang1 As Double, uang11 As Double, uang2 As Double, uang22 As Double, uang3 As Double, uang33 As Double
Call rs("select jumlah_bayar from Kelas where kode_Kelas='X'")
uang1 = rec!jumlah_bayar
uang11 = rec!jumlah_bayar
Call rs("select jumlah_bayar from Kelas where kode_Kelas='XI'")
uang2 = rec!jumlah_bayar
uang22 = rec!jumlah_bayar
Call rs("select jumlah_bayar from Kelas where kode_Kelas='XII'")
uang3 = rec!jumlah_bayar
uang33 = rec!jumlah_bayar
If rec.State = 1 Then rec.Close
rec.Open "select kelas from Siswa where nis='" & txtnis.Text & "'", conn, adOpenDynamic, adLockOptimistic
tampung = rec!kelas
For i = 0 To 11
s = i + 1
'uang = uang + Val(txtjml.Text)
If Len(tampung) = 7 And chkbulan(i).Value = Checked Then
Call rs("select no_bayar,bulan,total_bayar from Bayar where no_bayar='" & txtno_byr.Text & "'")
If Not rec.EOF Then
isi = rec!bulan
uang1 = uang1 + uang11
conn.Execute "update Bayar set bulan='" & isi & ", " & chkbulan(i).Caption & "',total_bayar=" & uang1 & " where no_bayar='" & txtno_byr.Text & "'"
Else
conn.Execute "Insert into Bayar values('" & txtno_byr.Text & "','" & DTPicker1.Value & "','" & txtnis.Text & "'," & txtjml.Text & ",'X','LUNAS','" & chkbulan(i).Caption & "')"
End If
ElseIf Len(tampung) = 8 And chkbulan(i).Value = Checked Then
Call rs("select no_bayar,bulan from Bayar where no_bayar='" & txtno_byr.Text & "'")
If Not rec.EOF Then
isi = rec!bulan
uang2 = uang2 + uang22
conn.Execute "update Bayar set bulan='" & isi & ", " & chkbulan(i).Caption & "',total_bayar=" & uang2 & " where no_bayar='" & txtno_byr.Text & "'"
Else
conn.Execute "Insert into Bayar values('" & txtno_byr.Text & "','" & DTPicker1.Value & "','" & txtnis.Text & "'," & txtjml.Text & ",'XI','LUNAS','" & chkbulan(i).Caption & "')"
End If
ElseIf Len(tampung) = 9 And chkbulan(i).Value = Checked Then
Call rs("select no_bayar,bulan from Bayar where no_bayar='" & txtno_byr.Text & "'")
If Not rec.EOF Then
isi = rec!bulan
uang3 = uang3 + uang33
conn.Execute "update Bayar set bulan='" & isi & ", " & chkbulan(i).Caption & "',total_bayar=" & uang3 & " where no_bayar='" & txtno_byr.Text & "'"
Else
conn.Execute "Insert into Bayar values('" & txtno_byr.Text & "','" & DTPicker1.Value & "','" & txtnis.Text & "'," & txtjml.Text & ",'XII','LUNAS','" & chkbulan(i).Caption & "')"
End If
End If
Next i
Call bersih(pembayaran)
Call otomatis
For i = 0 To 11
chkbulan(i).Value = Unchecked
Next i
kunci
'hell:
'MsgBox Err.Description
End Sub
Private Sub cmdtambah_Click()
' On Error GoTo hell
BukaKunci
cmdcari.SetFocus
For i = 0 To 11
chkbulan(i).Enabled = True
Next i
'hell:
'MsgBox Err.Description
End Sub
Private Sub Command1_Click()
Picture2.Visible = False
End Sub
Private Sub Form_Load()
Call koneksi
Call bersih(pembayaran)
Call otomatis
For i = 0 To 11
chkbulan(i).Enabled = False
Next i
kunci
Picture2.Visible = False
lvcari.ColumnHeaders.Clear
lvcari.View = lvwReport
lvcari.ColumnHeaders.Add , , "NIS", 1000
lvcari.ColumnHeaders.Add , , "NAMA", 2000
lvcari.ColumnHeaders.Add , , "KELAS", 1000
End Sub
Private Sub lvcari_DblClick()
'Dim haha As String
If rec.State = 1 Then rec.Close
rec.Open "select nis,nama_siswa,kelas from Siswa where nis='" & lvcari.SelectedItem & "'", conn, adOpenDynamic, adLockOptimistic
txtnis = rec!nis
txtnama = rec!nama_siswa
txtkelas = rec!kelas
If Len(txtkelas) = 7 Then
If rec.State = 1 Then rec.Close
rec.Open "select jumlah_bayar from Kelas where kode_kelas = 'X'", conn, adOpenDynamic, adLockOptimistic
txtjml = rec!jumlah_bayar
ElseIf Len(txtkelas) = 8 Then
If rec.State = 1 Then rec.Close
rec.Open "select jumlah_bayar from Kelas where kode_kelas ='XI'", conn, adOpenDynamic, adLockOptimistic
txtjml = rec!jumlah_bayar
ElseIf Len(txtkelas) = 9 Then
If rec.State = 1 Then rec.Close
rec.Open "select jumlah_bayar from Kelas where kode_kelas = 'XII'", conn, adOpenDynamic, adLockOptimistic
txtjml = rec!jumlah_bayar
End If
Picture2.Visible = False
End Sub
Private Sub Picture1_Click()
End Sub
Private Sub Text1_Change()
If rec.State = 1 Then rec.Close
rec.Open "select nis,nama_siswa,kelas from Siswa where nama_siswa like '%" & Text1.Text & "%'", conn, adOpenDynamic, adLockOptimistic
lvcari.ListItems.Clear
Do While Not rec.EOF
i = lvcari.ListItems.Count + 1
lvcari.ListItems.Add , , rec!nis
lvcari.ListItems(i).ListSubItems.Add , , rec!nama_siswa
lvcari.ListItems(i).ListSubItems.Add , , rec!kelas
rec.MoveNext
Loop
End Sub
Private Sub txtjml_Change()
If Len(txtkelas) <= 7 Then
If rec.State = 1 Then rec.Close
rec.Open "select * from Kelas where kode_kelas like 'X__' order by kode_kelas", conn, adOpenDynamic, adLockOptimistic
' cmbbln.Clear
Asc " "
Do While Not rec.EOF
' cmbbln.AddItem rec!Nama_Bulan
rec.MoveNext
Loop
ElseIf Len(txtkelas) > 7 And Len(txtkelas) <= 9 Then
If rec.State = 1 Then rec.Close
rec.Open "select * from Kelas where kode_kelas like 'XI__' order by kode_kelas", conn, adOpenDynamic, adLockOptimistic
' cmbbln.Clear
Asc " "
Do While Not rec.EOF
' cmbbln.AddItem rec!Nama_Bulan
rec.MoveNext
Loop
ElseIf Len(txtkelas) = 10 Then
If rec.State = 1 Then rec.Close
rec.Open "select * from Kelas where kode_kelas like 'XII__' order by kode_kelas", conn, adOpenDynamic, adLockOptimistic
' cmbbln.Clear
Asc " "
Do While Not rec.EOF
'cmbbln.AddItem rec!Nama_Bulan
rec.MoveNext
Loop
End If
End Sub
Sub otomatis()
If rec.State = 1 Then rec.Close
rec.Open "select no_bayar from Bayar order by no_bayar", conn, adOpenDynamic, adLockOptimistic
If Not rec.EOF Then
rec.MoveLast
If Left(rec!no_bayar, 6) = Format(Date, "YYYYMM") Then
txtno_byr = Trim(Str(Val(Right(rec!no_bayar, 4)) + 1))
txtno_byr = Format(Date, "YYYYMM") + Left("0000", 4 - Len(txtno_byr)) + txtno_byr
Else
txtno_byr = Format(Date, "YYYYMM") + "0001"
End If
Else
txtno_byr = Format(Date, "YYYYMM") + "0001"
End If
End Sub
Trimakasih...jika anda berminat bisa hubungi email atau no HP saya...
reski_alfan@yahoo.com
