PROGRAM SPP SMA / SMK dengan VB6

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