Contoh Form entry data buku + listing menggunakan VB 6.0

baik agan2  kali ini ane mw coba share gmn ngbuat 1 form menggunakan vb 6,disini form yang akan

kita buat adalah form entry data buku untuk program perpustakaan

pertama,kita harus buat database dulu dunk pastinya ,ok ane anggap agan2 udah bisa buat databasenya,

disini ane buat databasenya peke acces kedua,kita buat modul dulu karna disini

ane ngonekin db dengan formnya pake listing klik kanan d project,trus klik add module,

setelah tampil lalu agan isi dengan koding ini yah

Public Nama_Koneksi As String

Sub koneksi()

Nama_Koneksi = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\My Documents\Program Perpustakaan\Form\perpustakaanbsi2.mdb;Persist Security Info=False"

End Sub

"jangan lupa pas bikin db nya sesuaikan dengan db ane yah,biar gampang nantinya u/ yang ane tebelin itu nama db nya yah"

ok sekarang kita buat formnya,udah tau dunk cara buat formnya gimana,dah gitu tinggal masukin listingnya dech

COMPONENT :

textbox

datacombo

command button

datagrid

adodc

timer

frame

image

LISTING :

Dim c As Control

Dim Teks, Pesan As String

'Untuk merefresh agar data didatagrid muncul kembali

Sub Segar()

adobuku.RecordSource = "select * from buku"

adobuku.Refresh

End Sub

Sub Aktif()

For Each c In Me

     If TypeOf c Is TextBox Then c.Enabled = True

     Next c

     DataCombo1.Enabled = True

End Sub

Sub NonAktif()

For Each c In Me

     If TypeOf c Is TextBox Then c.Enabled = False

     Next c

     DataCombo1.Enabled = False

     Text1.Enabled = True

End Sub

Sub Simpan()

With adobuku.Recordset

     .Fields(0) = UCase(txtkd.Text)

     .Fields(1) = UCase(txtjudul.Text)

     .Fields(2) = UCase(txtpengarang.Text)

     .Fields(3) = UCase(txtpenerbit.Text)

     .Fields(4) = txttahun.Text

     .Fields(5) = UCase(DataCombo1.Text)

     .Update

End With

End Sub

Sub Tampil()

With adobuku.Recordset

     txtkd.Text = .Fields(0)

     txtjudul.Text = .Fields(1)

     txtpengarang.Text = .Fields(2)

     txtpenerbit.Text = .Fields(3)

     txttahun.Text = .Fields(4)

     DataCombo1.Text = .Fields(5)

End With

End Sub

Sub FormBersih()

For Each c In Me

     If TypeOf c Is TextBox Then c.Text = ""

     Next c

     DataCombo1.Text = "-PILIH-"

End Sub

Private Sub cmdbatal_Click()

Call NonAktif

Call FormBersih

Call Segar

cmdsimpan.Enabled = True

cmdhapus.Enabled = True

cmdubah.Caption = "Ubah"

End Sub

Private Sub cmdhapus_Click()

On Error GoTo errhapus

Pesan = MsgBox("Hapus data ini..?", vbYesNo + vbQuestion, "Info")

  

If Pesan = vbYes Then

     Call Aktif

     adobuku.Recordset.Delete

     Call FormBersih

     cmdsimpan.Enabled = True

     txtkd.SetFocus

Else

     Call NonAktif

     Call FormBersih

     cmdsimpan.Enabled = True

End If

     Call Segar

Exit Sub

errhapus:

MsgBox "Data gagal dihapus", vbCritical, "Peringatan"

End Sub

Private Sub cmdsimpan_Click()

On Error GoTo errsimpan

If txtkd.Text = "" Then txtkd.SetFocus: Exit Sub

If txtjudul.Text = "" Then txtjudul.SetFocus: Exit Sub

If txtpengarang.Text = "" Then txtpengarang.SetFocus: Exit Sub

If txtpenerbit.Text = "" Then txtpenerbit.SetFocus: Exit Sub

If txttahun.Text = "" Then txttahun.SetFocus: Exit Sub

If DataCombo1.Text = "-PILIH-" Then MsgBox "Anda belum memilih pilihan klasifikasi..!", vbCritical, "Peringatan": Exit Sub

'Proses Simpan

adobuku.Recordset.AddNew

Call Simpan

Call FormBersih

Pesan = MsgBox("Input data lagi..?", vbYesNo + vbQuestion, "Info")

If Pesan = vbYes Then

     txtkd.SetFocus

Else

     End

End If

Call Segar                                             'untuk merefresh agar data didatagrid muncul kembali

Exit Sub

errsimpan:

MsgBox "Maaf data error..!,kode buku sudah ada", vbCritical, "Peringatan"

End Sub

Private Sub cmdsimpan_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   cmdsimpan_Click

End If

End Sub

Private Sub cmdtambah_Click()

Call Aktif

txtkd.SetFocus

End Sub

Private Sub cmdtampil_Click()

If cmdtampil.caption = "Tampilkan Tabel " Then      

     FrmEntryBuku.Height = 7680

     cmdtampil.caption = "Sembunyikan "

Else

     cmdtampil.caption = "Tampilkan Tabel "

     FrmEntryBuku.Height = 4815

End If

End Sub

'Proses edit

Private Sub cmdubah_Click()

On Error GoTo errubah

If cmdubah.Caption = "Ubah" Then

     Call Aktif

     cmdubah.Caption = "Update"

     cmdsimpan.Enabled = False

     cmdhapus.Enabled = False

Else

     Call Simpan                                           'setelah di edit lakukan proses simpan

     MsgBox "Data berhasil diubah", vbOKOnly, "Info"     'karena memakai ado jadi tidak memakai .addnew

     Call FormBersih

     Call NonAktif

     cmdubah.Caption = "Ubah"

     cmdsimpan.Enabled = True

     cmdhapus.Enabled = True

     Call Segar                                         'untuk merefresh agar data didatagrid muncul kembali

End If

                                                 

Exit Sub

errubah:

MsgBox "Gagal ubah data", vbCritical, "Peringatan"

End Sub

Private Sub Form_Activate()

Call NonAktif

Teks = FrmEntryBuku.Caption

FrmEntryBuku.Height = 4815

DataCombo1.Text = "-PILIH-"

End Sub

'Proses buka koneksi

Private Sub Form_Load()

koneksi                                                 'membuka koneksi saat form di jalankan

With adobuku

     .ConnectionString = Nama_Koneksi                   'koneksi dengan koneksi baru atau newadodb

     .RecordSource = "select * from buku"

     .CommandType = adCmdText

     .Refresh

End With

With Adoklasifikasi

     .ConnectionString = Nama_Koneksi

     .RecordSource = "select * from klasifikasi"

     .CommandType = adCmdText

     .Refresh

End With

With DataGrid1

     .Columns(0).Width = 1000                                'merubah ukuran kolom

     .Columns(1).Width = 4000

     .Columns(2).Width = 2000

     .Columns(3).Width = 2000

     .Columns(4).Width = 1000

End With

End Sub

'Proses edit (untuk mencari kode yang akan di edit)

Private Sub Text1_Change()

adobuku.RecordSource = "select * from buku where KdBuku like'" & Text1.Text & "'"

adobuku.Refresh

If adobuku.Recordset.RecordCount <> 0 Then

     Call Tampil

     Call NonAktif

     cmdsimpan.Enabled = False

End If

End Sub

'Proses jika data yang dicari tidak ditemukan

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 And adobuku.Recordset.RecordCount = 0 Then

     MsgBox "Data tidak ditemukan", vbCritical, "Peringatan"

     Call FormBersih

     Call Segar

End If

End Sub

'Proses teks berjalan d judul form

Private Sub Timer1_Timer()

Teks = Right(Teks, Len(Teks) - 1) & Left(Teks, 1)

FrmEntryBuku.Caption = Teks

End Sub

'Proses limit digit PK (Primary Key)

Private Sub txtkd_Change()

If Len(txtkd.Text) > 5 Then                               'jika pengisian textbox kode buku lebih dari 5 maka akan muncul pesan error

   MsgBox "Anda melebihi batas 5 digit..!!!", vbCritical, "Peringatan"

   txtkd.Text = ""

End If

End Sub

owh iah agan2 jangan lupa yah untuk penamaan componennya disamakan,dirubah juga boleh asal agan mau teliti

semoga bermanfaat yah

                                                             -SELAMAT MENCOBA-