Pemrograman Visual I (VB)
STEKOM Semarang
v Buat folder baru bernama Pustaka v Buat database baru dengan Microsoft Access dengan nama DbPerpustakaan.mdb dan simpan dalam folder baru tersebut v Buat tabel baru dengan nama Anggota, dengan field-field sebagai berikut :
v Buka Project Baru simpan dengan PUSTAKA v Buat Form Baru untuk pengisian Data Anggota dan simpan dengan nama frmAnggota
'Siapkan Variabel untuk Connection dan Recordset Private conAgt As ADODB.Connection Private rsAgt As ADODB.Recordset Private strpath As String 'Prosedur/sub memindahkan(menyimpan) isi textbox kedalam tabel/recordset Private Sub IsiData() rsAgt!NoAgt = txtNo.Text rsAgt!NamaAgt = txtNama.Text rsAgt!AlamatAgt = txtAlamat.Text rsAgt!TelpAgt = txtTelp.Text End Sub 'Prosedur/sub menampilkan isi tabel/recordset ke textbox Private Sub Tampilkan() txtNo.Text = rsAgt!NoAgt txtNama.Text = rsAgt!NamaAgt txtAlamat.Text = rsAgt!AlamatAgt txtTelp.Text = rsAgt!TelpAgt End Sub 'Prosedur/sub untuk mengosongkan textbox Private Sub Kosongkan() For Each Control In Me If TypeOf Control Is TextBox Then Control.Text = "" End If Next End Sub
[email protected]
1
Pemrograman Visual I (VB)
STEKOM Semarang
'Prosedur/sub untuk me-nonaktifkan textbox Private Sub TidakBisaIsi() For Each Control In Me If TypeOf Control Is TextBox Then Control.Enabled = False End If Next End Sub 'Prosedur/sub untuk mengaktifkan textbox Private Sub BisaIsi() For Each Control In Me If TypeOf Control Is TextBox Then Control.Enabled = True End If Next End Sub 'Fungsi untuk menghitung dan menampilkan jumlah data Private Sub Jumlah() xjml = rsAgt.RecordCount LblJml.Caption = xjml End Sub Private Sub Auto() Dim Urutan As String * 5 Dim Hitung As Byte If AdoAnggota.Recordset.RecordCount = 0 Then Urutan = "A0001" Else AdoAnggota.Recordset.MoveLast Hitung = Val(Right(AdoAnggota.Recordset!NoAgt, 4)) + 1 Urutan = "A" & Right("0000" & Hitung, 4) End If txtNo.Text = Urutan End Sub Private Sub EdHapAktif() cmdedit.Enabled = True cmdhapus.Enabled = True End Sub 'Perintah saat form di load Private Sub Form_Load() 'Siapkan sintak ADO dan SQL untuk koneksi ke database dan tabel Dim CnStr, RsStr As String 'Isi variabel CnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & App.Path & "\dbPerpustakaan.mdb;" & _ "Persist Security Info=False" RsStr = "Select * from Anggota order by Noagt" 'Set/isi connection dengan nama database Set conAgt = New ADODB.Connection With conAgt .ConnectionString = CnStr .CursorLocation = adUseClient .Open End With 'Set/isi recordset dengan nama tabel Set rsAgt = New ADODB.Recordset rsAgt.Open RsStr, conAgt, adOpenStatic, adLockOptimistic, adCmdText 'Set/isi komponen Adodc dengan nama database dan tabel With AdoAnggota .ConnectionString = CnStr .CommandType = adCmdText .RecordSource = RsStr .Refresh End With
[email protected]
2
Pemrograman Visual I (VB)
STEKOM Semarang
TidakBisaIsi 'Non aktifkan textbox End Sub 'Perintah saat pertama kali form tampil dilayar Private Sub Form_Activate() cmdbaru.Enabled = True cmdsimpan.Enabled = False cmdedit.Enabled = False cmdhapus.Enabled = False cmdbatal.Enabled = False cmdkeluar.Enabled = True cmdbaru.Default = True 'Pembatasan pengisian masing-masing textbox txtNo.MaxLength = 5 txtNama.MaxLength = 25 txtAlamat.MaxLength = 30 txtTelp.MaxLength = 15 Jumlah End Sub 'Perintah jika tombol Baru diklik Private Sub cmdBaru_Click() Kosongkan 'Hapus/kosongkan semua isi textbox BisaIsi 'Aktifkan textbox Call Auto txtNama.SetFocus 'Bawa kursor ke textbox No_Anggota cmdbaru.Enabled = False cmdsimpan.Enabled = True cmdedit.Enabled = False cmdhapus.Enabled = False cmdbatal.Enabled = True cmdkeluar.Enabled = False End Sub 'Perintah jika tombol Simpan diklik Private Sub CmdSimpan_Click() 'Periksa pengisian No dan Nama, jika masih kosong tampilkan pesan If txtNo.Text = "" Then PESAN = MsgBox("Nomor Anggota harus di isi !", vbOKOnly, "Perhatian") txtNo.SetFocus Exit Sub End If If txtNama.Text = "" Then PESAN = MsgBox("Nama Anggota harus di isi !", vbOKOnly, "Perhatian") txtNama.SetFocus Exit Sub End If 'Cari apakah No_Anggota sudah ada rsAgt.Find "NoAgt='" & txtNo.Text & "'", , adSearchForward, 1 If Not rsAgt.EOF Then 'Jika ketemu maka rsAgt.UpdateBatch adAffectCurrent 'lakukan perbaikan/edit data Else rsAgt.AddNew 'jika belum tambahkan 1 record kosong End If IsiData rsAgt.Update 'Simpan data/record rsAgt.Requery 'Atur/tampilkan ulang AdoAnggota.Refresh Jumlah 'Periksa jumlah data TidakBisaIsi 'Non aktifkan textbox cmdbaru.Enabled = True cmdsimpan.Enabled = False cmdedit.Enabled = True cmdhapus.Enabled = True cmdbatal.Enabled = False cmdkeluar.Enabled = True End Sub 'Perintah jika tombol Edit diklik Private Sub cmdEdit_Click() BisaIsi 'aktifkan textbox
[email protected]
3
Pemrograman Visual I (VB)
STEKOM Semarang
txtNo.Enabled = False 'No_anggota tidak bisa di edit txtNama.SetFocus 'Kursor letakkan di textbox nama cmdbaru.Enabled = False cmdsimpan.Enabled = True cmdedit.Enabled = False cmdhapus.Enabled = False cmdbatal.Enabled = True cmdkeluar.Enabled = False End Sub 'Perintah jika tombol Hapus diklik Private Sub CmdHapus_Click() On Error Resume Next 'Tampilkan pertanyaan konformasi Hapus = MsgBox("No. Anggota " & txtNo.Text & " yakin akan dihapus ?", _ vbYesNo + 16, "Konfirmasi") If Hapus = vbYes Then rsAgt.Delete rsAgt.Requery AdoAnggota.Refresh End If
'Jika dijawab Yes 'Hapus data/record tersebut 'atur/tampilkan ulang recordset 'atur/tampilkan ulang data pada Adodc/DataGrid
If Not rsAgt.EOF Then 'Setelah penghapusan bawa ke record pertama rsAgt.MoveFirst Kosongkan 'Hapus/kosongkan semua textbox Else 'Jika data kosong tampilkan pesan X = MsgBox("Data Master Anggota Kosong !", vbInformation, "Perhatian") Exit Sub End If TidakBisaIsi 'Non aktifkan textbox Jumlah 'Tampilkan ulang jumlah data terbaru cmdbaru.Enabled = True cmdsimpan.Enabled = False cmdedit.Enabled = True cmdhapus.Enabled = True cmdbatal.Enabled = False cmdkeluar.Enabled = True End Sub 'Perintah jika tombol Batal diklik Private Sub cmdBatal_Click() rsAgt.Cancel Kosongkan TidakBisaIsi cmdbaru.Enabled = True cmdsimpan.Enabled = False cmdedit.Enabled = False cmdhapus.Enabled = False cmdbatal.Enabled = False cmdkeluar.Enabled = True End Sub 'Perintah jika tombol Cetak diklik Private Sub cmdcetak_Click() rptAnggota.ShowPrinter 'Tampilkan Report untuk Anggota End Sub 'Perintah jika tombol Cari diklik Private Sub CmdCari_Click() 'Tampilkan inputbox untuk menanyakan No_Anggota Y = InputBox("Masukkan No_Anggota ?", "Cari", "") 'Cari No Anggota dari record awal ke akhir mulai record 1 rsAgt.Find "NoAgt='" & Y & "'", , adSearchForward, 1 If Y = "" Then Exit Sub 'Jika inputbox di kosongkan maka keluar If Not rsAgt.EOF Then 'Jika pencarian tidak sampai EOF berarti ketemu Tampilkan 'Tampilkan data/record EdHapAktif Else MsgBox "No Anggota " & Y & " tidak ditemukan!", vbInformation, "Info" Kosongkan 'Hapus/kosongkan semua isi textbox End If
[email protected]
4
Pemrograman Visual I (VB)
STEKOM Semarang
End Sub 'Perintah jika tombol >> di klik Private Sub cmdAkhir_Click() If rsAgt.EOF And rsAgt.BOF Then Exit Sub End If rsAgt.MoveLast 'Bawa ke record terakhir Tampilkan 'Tampilkan data/record TidakBisaIsi 'Non aktifkan textbox EdHapAktif End Sub 'Perintah jika tombol << di klik Private Sub cmdAwal_Click() If rsAgt.EOF And rsAgt.BOF Then Exit Sub End If rsAgt.MoveFirst 'Bawa ke record pertama/awal Tampilkan 'Tampilkan data/record TidakBisaIsi 'Non aktifkan textbox EdHapAktif End Sub 'Perintah jika tombol > di klik Private Sub cmdBerikut_Click() If rsAgt.EOF And rsAgt.BOF Then Exit Sub End If rsAgt.MoveNext 'pindah/bawa ke record If rsAgt.EOF Then 'jika EOF maka rsAgt.MoveLast 'bawa/tampilkan record End If Tampilkan 'Tampilkan data/record EdHapAktif End Sub 'Perintah jika tombol < di klik Private Sub cmdSebelum_Click() If rsAgt.EOF And rsAgt.BOF Then Exit Sub End If rsAgt.MovePrevious 'pindah/bawa ke record If rsAgt.BOF Then 'jika BOF maka rsAgt.MoveFirst 'bawa/tampilkan record End If Tampilkan 'Tampilkan data/record EdHapAktif End Sub 'Perintah jika tombol keluar diklik Private Sub cmdkeluar_Click() conAgt.Close 'tutup connection Unload Me 'tutup form aktif End Sub
[email protected]
berikutnya terakhir
sebelumnya pertama
5
