Menu
 
» » » Form Data Siswa dengan Visual Basic

A+ A-
Form Data Siswa dengan Visual Basic 





Tabel Tool :




Tabel Menu : 



http://adf.ly/iliav
 
Code Programnya:
Option Explicit
Private koneksi As ADODB.Connection
Dim rsseting As New ADODB.Recordset

Private Function konek() As Boolean
    On Error GoTo out
        Set koneksi = New ADODB.Connection
        koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DbSekolah.mdb;Persist Security Info=False"
        koneksi.CursorLocation = adUseClient
        konek = True
out:
End Function

'Prosedur ketika ComboBox di klik
Private Sub CboJurusan_Click()
If CboJurusan.Tag = "1" Then Exit Sub 'jika kondisi sedang mengisi data keluar aja
    If CboJurusan.ListIndex > 0 Then
        rsseting.MoveFirst
        rsseting.Find "Jurusan='" & CboJurusan.Text & "'"
        If Not rsseting.BOF And Not rsseting.EOF Then
            TxtKeahlian.Text = rsseting("Progm_Keahlian")
            TxtKelas.SetFocus
        End If
    End If
End Sub

'seting koneksi tabel yang di hubungkan ke comboBox
Sub initrecorset()
Set rsseting = Nothing
    Set rsseting = New ADODB.Recordset
    rsseting.Open "Seting", koneksi, adOpenKeyset, adLockOptimistic
End Sub

Private Sub isiComboJurusan()
    CboJurusan.Clear
    CboJurusan.AddItem "Pilih Jurusan"
    CboJurusan.Tag = "1" 'kondisi sedang mengisi data
       
    If rsseting.RecordCount <= 0 Then Exit Sub 'jika gak ada isi data barang keluar aja
   
    rsseting.MoveFirst
    Do While Not rsseting.EOF
        CboJurusan.AddItem rsseting("Jurusan")
        rsseting.MoveNext
    Loop
    rsseting.MoveFirst
    CboJurusan.ListIndex = 0
    CboJurusan.Tag = "" 'kondisi selesai mengisi data
End Sub

Private Sub CboKelamin_Click()
TxtAgama.SetFocus
End Sub

'prosedure pembersihan/penghapusan text yang ada di TextBox
Private Sub CmdBatal_Click()
 TxtNIS.Text = ""
 TxtNama.Text = ""
 TxtAlamat.Text = ""
 TxtTmpLahir.Text = ""
 DTPicker1.Refresh
 CboKelamin.Text = ""
 TxtAgama.Text = ""
 TxtSkolAsal.Text = ""
 TxtTahun.Text = ""
 CboJurusan.Text = ""
 TxtKeahlian.Text = ""
 TxtKelas.Text = ""
 TxtNIS.SetFocus
 'merubah title tombol edit
 CmdEdit.Caption = "Edit"
End Sub

'pencarian data dengan menyaring DataGrid
Private Sub CmdCari_Click()
Adodc1.Recordset.Filter = "Nama ='" & TxtCariName & "'"
End Sub

Private Sub CmdCatek_Click()
DataReportSiswa.Show
End Sub

'prosedure ketika tombol edit di klik
Private Sub CmdEdit_Click()
If CmdEdit.Caption = "Edit" Then
'merubah title EDIT menjadi UPDATE
CmdEdit.Caption = "Update"
TxtNIS.SetFocus
Else
'proses penggantian data/penympana urang
With Adodc1.Recordset
.Fields("NIS") = TxtNIS.Text
.Fields("Nama") = TxtNama.Text
.Fields("Alamat") = TxtAlamat.Text
.Fields("Tempat_Lhr") = TxtTmpLahir.Text
.Fields("Tgl_Lahir") = Format(DTPicker1, "mm/dd/yyyy")
.Fields("JenisKelamin") = CboKelamin.Text
.Fields("Agama") = TxtAgama.Text
.Fields("Sekolah_Asal") = TxtSkolAsal.Text
.Fields("Tahun_Masuk") = TxtTahun.Text
.Fields("Jurusan") = CboJurusan.Text
.Fields("Keahlian") = TxtKeahlian.Text
.Fields("Kelas") = TxtKelas.Text
.Update
End With
Adodc1.Refresh
MsgBox "Data telah di Up Date!", vbInformation + vbOKOnly = vbIgnore
Call CmdBatal_Click
End If
End Sub

Private Sub CmdExit_Click()
If MsgBox("Yakin mau keluar?", vbQuestion + vbYesNo) = vbYes Then
        Unload Me
    End If
End Sub

'prosedure hapus
Private Sub CmdHapus_Click()
'membuat pertanyaan pengamanan sebelum di papus
Dim x As String
x = MsgBox(("Anda Yakin data ingin di hapus?"), vbYesNo + vbCritical)
If x = vbYes Then
'perintah menghapus data
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveFirst
DataGrid1.ReBind
DataGrid1.Refresh
'Membuat laporannya
MsgBox "Data  telah di Hapus!", vbInformation + vbOKOnly = vbIgnore
End If
End Sub

Private Sub CmdRefrash_Click()
TxtCariName.Text = ""
Adodc1.Refresh
DataGrid1.Refresh
End Sub

Private Sub CmdSimpan_Click()
'mengecek Nomor Induk Siswa untuk mencegah ada yang sama
Adodc1.Recordset.Find "NIS='" + TxtNIS.Text + "'", , adSearchForward, 1
If Not Adodc1.Recordset.EOF Then
     MsgBox ("Nomor Induk Siswa Ini" + TxtNIS.Text + Chr(13) + _
        "Sudah Ada !")
     TxtNIS.Text = ""
     TxtNIS.SetFocus
Else
'memerikasa data Texbox yang tidak terisi
 If MsgBox("Anda yakin data sudah benar", vbQuestion + vbYesNo) = vbYes Then
  If Trim$(TxtNama.Text) = "" Then
        MsgBox "Nama harus di isi!", vbExclamation
        TxtNama.SetFocus
        Exit Sub
    ElseIf TxtAlamat.Text = "" Then
        MsgBox "Alamat Siswa Harus di isi!", vbExclamation
        TxtAlamat.SetFocus
        Exit Sub
    ElseIf TxtTmpLahir.Text = "" Then
        MsgBox "Tempat Lahir Siswa harus di isi!", vbExclamation
        TxtTmpLahir.SetFocus
        Exit Sub
    ElseIf TxtAgama.Text = "" Then
        MsgBox "Agama Siswa Harus di isi!", vbExclamation
        TxtAgama.SetFocus
        Exit Sub
    ElseIf TxtSkolAsal.Text = "" Then
        MsgBox "Sekolah asal Siswa harus di isi!", vbExclamation
        TxtSkolAsal.SetFocus
        Exit Sub
    End If
End If
'Penyimpanan data ke tabel
With Adodc1.Recordset
.AddNew
.Fields("NIS") = TxtNIS.Text
.Fields("Nama") = TxtNama.Text
.Fields("Alamat") = TxtAlamat.Text
.Fields("Tempat_Lhr") = TxtTmpLahir.Text
.Fields("Tgl_Lahir") = Format(DTPicker1, "mm/dd/yyyy")
.Fields("JenisKelamin") = CboKelamin.Text
.Fields("Agama") = TxtAgama.Text
.Fields("Sekolah_Asal") = TxtSkolAsal.Text
.Fields("Tahun_Masuk") = TxtTahun.Text
.Fields("Jurusan") = CboJurusan.Text
.Fields("Keahlian") = TxtKeahlian.Text
.Fields("Kelas") = TxtKelas.Text
.Update
End With
'Melaporkan jika sudah tersimpan
MsgBox "Data telah di Simpan!", vbInformation + vbOKOnly = vbIgnore
'Memanggil perintah yang ada di tombol batal
Call CmdBatal_Click
End If
End Sub

'Menampilakan data saat baris  DataGrid di Klik
Private Sub DataGrid1_Click()
If Adodc1.Recordset.RecordCount <= 0 Then Exit Sub
    If Not Adodc1.Recordset.BOF And Not Adodc1.Recordset.EOF Then
        TxtNIS.Text = Adodc1.Recordset.Fields("NIS")
        TxtNama.Text = Adodc1.Recordset.Fields("Nama")
        TxtAlamat.Text = Adodc1.Recordset.Fields("Alamat")
        TxtTmpLahir.Text = Adodc1.Recordset.Fields("Tempat_Lhr")
        DTPicker1.Value = Adodc1.Recordset.Fields("Tgl_Lahir")
        CboKelamin.Text = Adodc1.Recordset.Fields("JenisKelamin")
        TxtAgama.Text = Adodc1.Recordset.Fields("Agama")
        TxtSkolAsal.Text = Adodc1.Recordset.Fields("Sekolah_Asal")
        TxtTahun.Text = Adodc1.Recordset.Fields("Tahun_Masuk")
        CboJurusan.Text = Adodc1.Recordset.Fields("Jurusan")
        TxtKeahlian.Text = Adodc1.Recordset.Fields("Keahlian")
        TxtKelas.Text = Adodc1.Recordset.Fields("Kelas")
    End If
End Sub

Private Sub Form_Activate()
CboKelamin.AddItem "Laki-Laki"
CboKelamin.AddItem "Perempuan"
End Sub

'dekralasi koneksi tabel yang di hubungkan ke Adodc
Private Sub Form_Load()
If Not konek() Then
        MsgBox "Gak bisa terhubung ke database!", vbCritical
        End
    End If
    Call initrecorset
    Call isiComboJurusan
    Adodc1.ConnectionString = koneksi.ConnectionString
    Adodc1.RecordSource = "Siswa"
    Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub nmAbout_Click()
FrmAbout.Show
End Sub

Private Sub nmbayar_Click()
Unload Me
FrmSPP.Show
End Sub

'pertanyaan sebelum keluar
Private Sub nmExit_Click()
If MsgBox("Yakin mau keluar?", vbQuestion + vbYesNo) = vbYes Then
        Unload Me
    End If
End Sub

Private Sub nmpembayaran_Click()
DataReportPembayaran.Show
End Sub

Private Sub nmSiswa_Click()
DataReportSiswa.Show
End Sub

Private Sub TxtAgama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtSkolAsal.SetFocus
End If
End Sub

Private Sub TxtAlamat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtTmpLahir.SetFocus
End If
End Sub

Private Sub TxtKelas_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call CmdSimpan_Click
End If
End Sub

Private Sub TxtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtAlamat.SetFocus
End If
End Sub

Private Sub TxtNIS_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim x As String
'Memeriksan NIS yang ada di tabel
Adodc1.Recordset.Find "NIS='" + TxtNIS.Text + "'", , adSearchForward, 1
 If Not Adodc1.Recordset.EOF Then
'Juka sudah ada Tmpilkan petanyaan untk edit?
    x = MsgBox(("NIS Sudah Ada, Apakah Anda Ingin Mengeditnya?"), vbYesNo + vbCritical)
'jika jawabanya Yas maka tampilkn data jika tidak TextBoxNIS di bersihkan & difokoskan
    If x = vbYes Then
        TxtNIS.Text = Adodc1.Recordset.Fields("NIS")
        TxtNama.Text = Adodc1.Recordset.Fields("Nama")
        TxtAlamat.Text = Adodc1.Recordset.Fields("Alamat")
        TxtTmpLahir.Text = Adodc1.Recordset.Fields("Tempat_Lhr")
        DTPicker1.Value = Adodc1.Recordset.Fields("Tgl_Lahir")
        CboKelamin.Text = Adodc1.Recordset.Fields("JenisKelamin")
        TxtAgama.Text = Adodc1.Recordset.Fields("Agama")
        TxtSkolAsal.Text = Adodc1.Recordset.Fields("Sekolah_Asal")
        TxtTahun.Text = Adodc1.Recordset.Fields("Tahun_Masuk")
        CboJurusan.Text = Adodc1.Recordset.Fields("Jurusan")
        TxtKeahlian.Text = Adodc1.Recordset.Fields("Keahlian")
       TxtKelas.Text = Adodc1.Recordset.Fields("Kelas")
    Else
     TxtNIS.Text = ""
     TxtNIS.SetFocus
    End If
   Else
   TxtNama.SetFocus
 End If
End If
End Sub

Private Sub TxtSkolAsal_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtTahun.SetFocus
End If
End Sub

Private Sub TxtTahun_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
CboJurusan.SetFocus
End If
End Sub


back to Program Pembayaran SPP Visual Basic 

















Posted by











Labels:
,















at
12:05 AM





































Post a Comment
















































        

      








Subscribe to:
Post Comments (Atom)















 





Top