Thursday, August 28, 2008

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
Bagikan
Posted by

12 comments:

  1. AnonymousDecember 27, 2008 at 9:31 AM

    Mas.. koq aku ga bs download yah?

    ReplyDelete
  2. VBasicCodeSeptember 2, 2009 at 11:43 AM

    hehe.. memang sialan ni... banyak file -file yang aku upload ilang..hehe..

    ReplyDelete
  3. VBasicCodeOctober 23, 2009 at 4:14 PM

    Sekarang projeect sudah saya upload dengan nama file MyBooks.zip
    Thanks.

    ReplyDelete
  4. HusenDecember 19, 2010 at 11:22 AM

    izin sdot bozz mau belajar ah

    ReplyDelete
  5. VBasicCodeDecember 21, 2010 at 1:14 PM

    Silahkan Mas Husen,semoga bermanfaat.

    ReplyDelete
  6. Succes_live.blogspot.comMay 31, 2011 at 12:09 PM

    bro,bikin project nya gimana? kasi langkah step by step dong!

    ReplyDelete
  7. VBasicCodeJune 16, 2011 at 5:59 PM

    Mas Succe, untuk langkahnya tinggal download dan cermati Source codenya..^_^..
    Makasih^-^

    ReplyDelete
  8. Ahmad fauziAugust 10, 2011 at 1:03 AM

    pengen belajar ahh, ajarin ya..mas ganteng

    ReplyDelete
  9. Ukel Marue KheillJanuary 13, 2012 at 9:39 PM

    Tks

    ReplyDelete
  10. herytasronyApril 9, 2012 at 1:52 PM

    izin sedot MasBro pengen belajar............Tengkiu

    ReplyDelete
  11. masih perbaikanAugust 5, 2013 at 8:33 PM

    alamt downloadx kug ad virus'na?mhon alternatif alamt downloadx ksi agy dunk?mksh!!!

    ReplyDelete
  12. samsDecember 1, 2013 at 12:37 AM

    bagaimana memperbaiki hardik yang badsector?
    bagaimana memperbaiki flashdisk dengan mudah?
    bagaimana install windows yang benar?
    panduan memperbaiki hardik
    how to fix laptop

    ReplyDelete

Subscribe to: Post Comments (Atom)