MyBooks Database

Sekarang kita mencoba belajar Database visual basic, yaitu database dengan menggunakan Microsoft Office Acces sebagai sumber datanya.Program ini sebagai janji saya kepada beberapa pengunjung yang menanyakan mengenai database. Kita akan membuat sebuah aplikasi sederhana "Koleksi Bukuku" yang berfungsi untuk menyimpan daftar koleksi buku yang mungkin sangat banyak dan kita belum sempat melakukan inventarisasi terhadapnya.Saya sendiri sempat terkejut pada saat saya membuat project ini karena ketika saya memasukan data buku-buku saya eh..ternyata jumlahnya lumayan banyak yaitu 45 buku, bayangkan jika semua buku tersebut minimal harganya 25.000 sudah menghabiskan berapa rupiah nih ..???
Tapi semua buku pasti bermanfaat dan saya tentu tidak menyesal untuk membelinya dan memilikinya.
Thanks My Books.

Baik langsung saja yang dibutuhkan dalam project ini adalah :

1. satu form dengan nama main
2. satu dataenvironment dengan nama dataenvironment1
3. datareport dengan nama datareport1

Control yang ada didalam form, yaitu :

1. Imagelist1 sebagai penampung image untuk toolbar
2. Toolbar1 sebagai tempat menampung gambar yang akan dapat di klik langsung oleh user
3. frame1 sebagai tempat
4. tujuh Textbox yaitu txtjudul, txtreferensi, txtpenulis, txtcetakan, txtpenerbit, txtrecordaktif dan txtsearch
5. satu ComboBox yaitu cbosearch
6. satu CommandButton yaitu cmdcari
7. membuat Menubar untuk menampung File, Tambah, Hapus, urut sesuai Judul , urut sesuai Resensi dan seterusnya.

Fasilitas yang ada pada project sederhana ini adalah :

1. Pencarian
2. Tambah data
3. Hapus Data
4. Update data
5. Pembatalan data
6. Simpan data
7. Edit data
8. Menampilkan laporan yang lumayan tampilannya
9. Lebih fleksibel karena untuk koneksi ke database menggunakan kode dan tidak menggunakan Adodc yang saya rasa kurang fleksibel dalam koneksi database.
10. Navigasi (Next, Previous, First dan Last) yang diletakan di menubar sehingga lebih hemat tempat.

BACA DAHULU CODE-CODE DIBAWAH INI KHUSUSNYA PADA "MNUITEMREPORT" DAN "CASE LAPORAN". JANGAN JALANKAN JIKA BELUM DICOMPILE KARENA NANTI WALAUPUN SUDAH ANDA STOP PROJECT ANDA MAKA APLIKASI YANG BERADA DIFOLDER INI YAITU "KOLEKSIBUKUKU.EXE" AKAN DIJALANKAN !!!

BACA ALASANYA DI "MNUITEMREPORT" DAN "CASE LAPORAN".

Masukan semua kode di bawah ini dalam form

Option Explicit Private WithEvents adoPrimaryRSdaftarBuku As Recordset   Private Sub CboSearch_Click() 'jika cbosearch diklik Select Case CboSearch   'memilih Judul Case "Judul" TxtSearch.Text = "" TxtSearch.Enabled = True TxtSearch.BackColor = vbWindowText TxtSearch.SetFocus   Case "Referensi" TxtSearch.Text = "" TxtSearch.Enabled = True TxtSearch.BackColor = vbWindowText TxtSearch.SetFocus   Case "Penulis" TxtSearch.Text = "" TxtSearch.Enabled = True TxtSearch.BackColor = vbWindowText TxtSearch.SetFocus   Case "Penerbit" TxtSearch.Text = "" TxtSearch.Enabled = True TxtSearch.BackColor = vbWindowText TxtSearch.SetFocus End Select End Sub   Private Sub DisableSearch() TxtSearch.Enabled = False TxtSearch.BackColor = vbWindowText TxtSearch.Text = "Masukan Kata Kunci Pencarian" CboSearch.Text = "Pencarian" End Sub   Private Sub Command1_Click() If TxtSearch.Text = "" Then Beep TxtSearch.SetFocus Else 'jika cbosearch dipilih Select Case CboSearch   Case "Judul" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Judul like '*" + TxtSearch + "*'", , adSearchForward, 1   Case "Referensi" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Referensi like '*" + TxtSearch + "*'", , adSearchForward, 1   Case "Penulis" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Penulis like '*" + TxtSearch + "*'", , adSearchForward, 1 Case "Penerbit" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Penerbit like '*" + TxtSearch + "*'", , adSearchForward, 1 End Select   'jika data tidak ditemukan maka If adoPrimaryRSdaftarBuku.EOF Then MsgBox "Data yang anda cari tidak ditemukan", vbOKOnly + vbCritical, "Search" adoPrimaryRSdaftarBuku.MoveFirst TxtSearch.Text = "" TxtSearch.SetFocus End If End If On Error GoTo 0 LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub Private Sub Form_Load() Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & _   "Data Source=" & App.Path & "\Daftar Buku.mdb;"   Set adoPrimaryRSdaftarBuku = New Recordset adoPrimaryRSdaftarBuku.Open "TblDaftarBuku", db, adOpenStatic, adLockOptimistic   'Bind the ole controls to the data provider Set txtJudul.DataSource = adoPrimaryRSdaftarBuku Set txtReferensi.DataSource = adoPrimaryRSdaftarBuku Set txtPenulis.DataSource = adoPrimaryRSdaftarBuku Set TxtCetakan.DataSource = adoPrimaryRSdaftarBuku Set txtPenerbit.DataSource = adoPrimaryRSdaftarBuku 'mengurutkan berdasarkan field referensi adoPrimaryRSdaftarBuku.Sort = "Referensi" LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub  Private Sub Form_Unload(Cancel As Integer) adoPrimaryRSdaftarBuku.Close End Sub Private Sub MnuBatal_Click() DisableSearch 'disable textbox txtJudul.Enabled = False txtReferensi.Enabled = False txtPenulis.Enabled = False TxtCetakan.Enabled = False txtPenerbit.Enabled = False 'batalkan update kemudian menuju ke record pertama adoPrimaryRSdaftarBuku.CancelUpdate adoPrimaryRSdaftarBuku.MoveFirst End Sub  Private Sub mnuitemabout_Click() DisableSearch 'menampilkan pesan mengenai aplikasi MsgBox "Koleksi Bukuku Version 1.0.0 Oleh Joko", vbInformation, "Koleksi Bukuku" End Sub  Private Sub mnuitemadd_Click() DisableSearch 'menambah data buku adoPrimaryRSdaftarBuku.AddNew 'textbox enable/dapat diisi txtJudul.Enabled = True txtReferensi.Enabled = True txtPenulis.Enabled = True TxtCetakan.Enabled = True txtPenerbit.Enabled = True 'pointer aktif di txtjudul txtJudul.SetFocus End Sub  Private Sub mnuitemdelete_Click() DisableSearch If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasi" txtReferensi.Text = "." adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst Else 'Hapus daftar buku record aktif adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst End If LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub Private Sub mnuitemedit_Click() DisableSearch 'mengaktifkan textbox agar dapat diubah daftar bukunya txtJudul.Enabled = True txtReferensi.Enabled = True txtPenulis.Enabled = True TxtCetakan.Enabled = True txtPenerbit.Enabled = True End Sub Private Sub mnuitemexit_Click() 'mengakhiri aplikasi Unload Me End Sub Private Sub mnuitemreport_Click() DisableSearch 'INI CODE UPDATE REPORT/LAPORAN YANG BURUK TETAPI EFEKTIF DAN TIDAK BIKIN SAYA PUSING HE..HE.., 'SAYA TULISKAN KARENA JIKA KITA BUKA LAPORAN DAN MENUTUPNYA KEMBALI KEMUDIAN KITA MELAKUKAN PERUBAHAN 'PADA DATA (PENAMBAHAN ATAU PENGHAPUSAN DATA) TERNYATA JIKA KITA BUKA KEMBALI LAPORAN 'MAKA DIHASILKAN LAPORAN YANG MASIH LAMA (BELUM MENGALAMI PENAMBAHAN/PENGHAPUSAN) 'SEHINGGA SAYA LAKUKAN CODE DIBAWAH INI YAITU MENUTUP APLIKASI DAN MEMANGGILNYA KEMBALI 'KEMUDIAN BARU LAPORAN (DATAREPORT1) DITAMPILKAN. MAAF MENGGUNAKAN JALAN PINTAS HE..HE...BAGI YANG TAHU BAGI ILMU DONG..   Unload Main 'MENUTUP APLIKASI Shell App.Path & "\KOLEKSIBUKUKU.EXE" 'MEMANGGIL APLIKASI KEMBALI DataReport1.Show 'MENAMPILKAN LAPORAN End Sub Private Sub mnuitemsave_Click() DisableSearch If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasi" txtReferensi.Text = "." adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst Else 'menyimpan daftar buku yang telah di inputkan adoPrimaryRSdaftarBuku.Save End If txtJudul.Enabled = False txtReferensi.Enabled = False txtPenulis.Enabled = False TxtCetakan.Enabled = False txtPenerbit.Enabled = False LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub  Private Sub MnuFirst_Click() 'menuju ke record pertama adoPrimaryRSdaftarBuku.MoveFirst DisableSearch LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub Private Sub MnuLast_Click() 'menuju ke record terakhir adoPrimaryRSdaftarBuku.MoveLast DisableSearch LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub Private Sub mnunext_Click() 'menuju ke record setelah/ke depan adoPrimaryRSdaftarBuku.MoveNext 'jika record sudah sampai pada record yang terakhir maka akan berbunyi nada beep dan record yang aktif adalah record terakhir If adoPrimaryRSdaftarBuku.EOF Then Beep adoPrimaryRSdaftarBuku.MoveLast End If DisableSearch LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub Private Sub mnuprevious_Click() adoPrimaryRSdaftarBuku.MovePrevious 'jika record sudah sampai pada record yang pertama maka akan berbunyi nada beep dan record yang aktif adalah record pertama If adoPrimaryRSdaftarBuku.BOF Then Beep adoPrimaryRSdaftarBuku.MoveFirst End If   DisableSearch LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition End Sub  Private Sub MnuUpdate_Click() DisableSearch With adoPrimaryRSdaftarBuku 'mengedit data pada record aktif .Clone !Judul = txtJudul.Text !Referensi = txtReferensi.Text !Penulis = txtPenulis.Text !cetakan = TxtCetakan.Text !Penerbit = txtPenerbit.Text 'menyimpan hasil pengeditan data .Update End With   If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasi" mnuitemdelete_Click End If End Sub  Private Sub MnuUrutJudul_Click() 'mengurutkan berdasarkan field Judul adoPrimaryRSdaftarBuku.Sort = "Judul" DisableSearch End Sub Private Sub MnuUrutpenerbit_Click() 'mengurutkan berdasarkan field Penerbit adoPrimaryRSdaftarBuku.Sort = "Penerbit" DisableSearch End Sub Private Sub MnuUrutPenulis_Click() 'mengurutkan berdasarkan field Penulis adoPrimaryRSdaftarBuku.Sort = "Penulis" DisableSearch End Sub  Private Sub MnuUrutReferensi_Click() 'mengurutkan berdasarkan field referensi adoPrimaryRSdaftarBuku.Sort = "Referensi" DisableSearch End Sub  Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)   'menggunakan statemen select case 'initialisasi toolbar dan isi Select Case Button.Key   Case "Tambah" 'disabled TxtSearch DisableSearch   'menambah daftar koleksi buku adoPrimaryRSdaftarBuku.AddNew txtJudul.Enabled = True txtReferensi.Enabled = True txtPenulis.Enabled = True TxtCetakan.Enabled = True txtPenerbit.Enabled = True txtJudul.SetFocus   Case "Simpan" DisableSearch   If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasi" txtReferensi.Text = "." adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst Else 'menyimpan daftar buku yang telah di inputkan adoPrimaryRSdaftarBuku.Save End If   txtJudul.Enabled = False txtReferensi.Enabled = False txtPenulis.Enabled = False TxtCetakan.Enabled = False txtPenerbit.Enabled = False   LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition   Case "Hapus" DisableSearch If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasit" txtReferensi.Text = "." adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst Else 'Hapus daftar buku record aktif adoPrimaryRSdaftarBuku.Delete adAffectCurrent adoPrimaryRSdaftarBuku.MoveFirst End If   LblRecordAktif.Caption = " Jumlah Koleksi " & adoPrimaryRSdaftarBuku.RecordCount & " Buku" & " dan Sekarang Posisi di Koleksi Buku ke " & adoPrimaryRSdaftarBuku.AbsolutePosition   Case "Laporan" DisableSearch   'INI CODE UPDATE REPORT/LAPORAN YANG BURUK TETAPI EFEKTIF DAN TIDAK BIKIN SAYA PUSING HE..HE.., 'SAYA TULISKAN KARENA JIKA KITA BUKA LAPORAN DAN MENUTUPNYA KEMBALI KEMUDIAN KITA MELAKUKAN PERUBAHAN 'PADA DATA (PENAMBAHAN ATAU PENGHAPUSAN DATA) TERNYATA JIKA KITA BUKA KEMBALI LAPORAN 'MAKA DIHASILKAN LAPORAN YANG MASIH LAMA (BELUM MENGALAMI PENAMBAHAN/PENGHAPUSAN) 'SEHINGGA SAYA LAKUKAN CODE DIBAWAH INI YAITU MENUTUP APLIKASI DAN MEMANGGILNYA KEMBALI 'KEMUDIAN BARU LAPORAN (DATAREPORT1) DITAMPILKAN. MAAF MENGGUNAKAN JALAN PINTAS HE..HE...BAGI YANG TAHU BAGI ILMU DONG..   Unload Main 'MENUTUP APLIKASI Shell App.Path & "\KoleksiBukuku.exe" 'MEMANGGIL APLIKASI KEMBALI DataReport1.Show 'MENAMPILKAN LAPORAN   Case "Ubah" DisableSearch   'membuat textbox dapat di edit/ubah txtJudul.Enabled = TruetxtReferensi.Enabled = True txtPenulis.Enabled = True TxtCetakan.Enabled = True txtPenerbit.Enabled = True   Case "Batal" DisableSearch 'disable textbox txtJudul.Enabled = False txtReferensi.Enabled = False txtPenulis.Enabled = False TxtCetakan.Enabled = False txtPenerbit.Enabled = False 'batalkan update kemudian menuju ke record pertama adoPrimaryRSdaftarBuku.CancelUpdate adoPrimaryRSdaftarBuku.MoveFirst   Case "Update" DisableSearch With adoPrimaryRSdaftarBuku .Clone !Judul = txtJudul.Text !Referensi = txtReferensi.Text !Penulis = txtPenulis.Text !cetakan = TxtCetakan.Text !Penerbit = txtPenerbit.Text 'menyimpan hasil pengeditan data .Update End With   If txtJudul.Text = "" Then MsgBox "Minimal Ketik Judul Bukunya dulu.", vbOKOnly, "Informasi" mnuitemdelete_Click End If   Case "Keluar" 'keluar dari aplikasi Unload Me End Select End Sub  Private Sub TxtSearch_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) On Error Resume Next 'jika menekan enter If KeyAscii = 13 Then TxtSearch.SetFocus TxtSearch.SelStart = 0 TxtSearch.SelLength = Len(TxtSearch.Text)   'jika cbosearch dipilih Select Case CboSearch   Case "Judul" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Judul like '*" + TxtSearch + "*'", , adSearchForward, 1   Case "Referensi" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Referensi like '*" + TxtSearch + "*'", , adSearchForward, 1   Case "Penulis" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Penulis like '*" + TxtSearch + "*'", , adSearchForward, 1   Case "Penerbit" 'melakukan pencarian data pd txtsearch adoPrimaryRSdaftarBuku.Find "Penerbit like '*" + TxtSearch + "*'", , adSearchForward, 1 End Select   'jika data tidak ditemukan maka If adoPrimaryRSdaftarBuku.EOF Then MsgBox "Data yang anda cari tidak ditemukan",vbOKOnly + vbCritical, "Search" adoPrimaryRSdaftarBuku.MoveFirst TxtSearch.Text = "" TxtSearch.SetFocus End If End If On Error GoTo 0 End Sub  Letakan kode di bawah ini di Data environment1  Private Sub DataEnvironment_Initialize() 'Selalu terkoneksi dengan database "Daftar Buku.mdb" asalkan masih dalam satu folder dengan aplikasi. 'Akibat jika anda lupa tdk menulis kode di bawah ini adalah '- muncul pesan untuk memasukan alamat yang benar database pada saat akan melihat laporan/report, 'pesan ini muncul karena anda membuat folder baru untuk meletakkan project sehingga alamat tdk ditemukan 'untuk latihan jangan tulis kode di bawah ini tetapi melalui Dataenvironment1 klik kanan properties 'pilih alamat file database "Daftar Buku.mdb". Kemudian coba jalankan aplikasi dan 'pilih laporan maka laporan akan terlihat. Sekarang keluar dari VB dan pindahkan folder project anda 'ke sembarang (alamat baru), jalankan aplikasi database masih terkoneksi 'tetapi pada saat ingin melihat laporan akan muncul pesan error.   DataEnvironment1.DaftarBuku.ConnectionString = App.Path & "\Daftar Buku.mdb"   End Sub

Semoga bermanfaat
Download Data Base MyBooks