Sebelum membuat form diatas kita harus membuat database pada Microsoft Acces dengan nama Data dan tabelnya dengan nama Barang dengan field-field dibawah ini :
| Field Name | Data Type | Size |
| Kode | Text | 5 |
| Nama_Barang | Text | 50 |
| Persediaan | Number | Long Integer |
| Harga_Beli | Currency | |
| Harga_Jual | Currency | |
Setelah membuat database kita mulai membuat form dengan komponen-komponen
| Komponen | Caption | Name | Text |
| Label1 | Kode Barang | | |
| Label2 | Nama Barang | | |
| Label3 | Persediaan | | |
| Label4 | Harga Beli | | |
| Label5 | Harga Jual | | |
| TextBox1 | | TKode | Kosongkan |
| TextBox2 | | TNama | Kosongkan |
| TextBox3 | | TPersediaan | Kosongkan |
| TextBox4 | | TBeli | Kosongkan |
| TextBox5 | | TJual | Kosongkan |
| CommandButton1 | &Tambah | TomTambah | |
| CommandButton | &Edit | TomEdit | |
| CommandButton | &Simpan | TomSimpan | |
| CommandButton | &Hapus | TomBatal | |
| CommandButton | &First | TomFirst | |
| CommandButton | &Prev | TomPrev | |
| CommandButton | &Next | TomNext | |
| CommandButton | &Last | TomLast | |
| CommandButton | Pencarian | Command1 | |
| Adodc1 | | | |
| DataGrid1 | | | |
Dan listing programnya dibawah ini :
Sub NavigasiOn()
Me.TomLast.Enabled = True
Me.TomNext.Enabled = True
Me.TomFirst.Enabled = True
Me.TomPrevious.Enabled = True
End Sub
Sub NavigasiOff()
Me.TomLast.Enabled = False
Me.TomNext.Enabled = False
Me.TomFirst.Enabled = False
Me.TomPrevious.Enabled = False
End Sub
Sub Kosong()
Me.TBeli = ""
Me.TJual = ""
Me.TKode = ""
Me.TPersediaan = ""
Me.TNama = ""
End Sub
Sub KotakKunci()
Me.TBeli.Locked = True
Me.TJual.Locked = True
Me.TKode.Locked = True
Me.TNama.Locked = True
Me.TPersediaan.Locked = True
End Sub
Sub KotakBuka()
Me.TBeli.Locked = False
Me.TJual.Locked = False
Me.TKode.Locked = False
Me.TNama.Locked = False
Me.TPersediaan.Locked = False
End Sub
Sub Isi()
On Error GoTo err
With Me.Adodc1.Recordset
Me.TBeli = !Harga_Beli
Me.TJual = !Harga_Jual
Me.TKode = !Kode
Me.TNama = !Nama_Barang
Me.TPersediaan = !Persediaan
End With
Exit Sub
err:
MsgBox "Error " & err.Number & " : " & err.Description
End Sub
Private Sub Command1_Click()
Dim cari As String
cari = InputBox("Masukkan kode yang akan dicari !", "Pencarian Barang")
With Me.Adodc1.Recordset
If Not .RecordCount = 0 Then
.MoveFirst
.Find "Kode ='" & cari & "'", , adSearchForward, 1
If Not .EOF Then
Isi
Else
MsgBox "Kode barang tidak ada", vbOKOnly, "Peringatan!"
.MoveFirst
Isi
End If
End If
End With
End Sub
Private Sub Form_Load()
With Me.Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Data.mdb;Persist Security" 'u/ mengoneksikan ado ke database jadisatu, app.path itu u/ mencari database jadisatu, satu dengan program ini
.CommandType = adCmdTable ' masukannya berdasarkan tabel
.RecordSource = "Barang" 'mengoneksikan ke tabel siswa ortu
.Refresh 'meyegarkan ado biar data diatas bisa dijalankan
End With
With Me.Adodc1.Recordset
If Not .BOF Then
TomBatal_Click
Else
TomTambah_Click
End If
End With
KotakKunci
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Adodc1.Recordset.CancelBatch
End Sub
Private Sub TBeli_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
MsgBox "Yang dimasukkan harus angka !", vbInformation, "HarusAngka !"
End If
End Sub
Private Sub TJual_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
MsgBox "Yang dimasukkan harus angka !", vbInformation, "HarusAngka !"
End If
End Sub
Private Sub TKode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub TomBatal_Click()
NavigasiOn
Me.TomBatal.Enabled = False
Me.TomEdit.Enabled = True
Me.TomSimpan.Enabled = False
Me.TomTambah.Enabled = True
Me.TomHapus.Enabled = True
With Me.Adodc1.Recordset
If Not .BOF Then ' bof (begin of file) jika tidak kosong maka program di bawah ini di jalankan
.CancelBatch 'membatalkan fungsi addnew
.MoveFirst
Isi 'untuk memanggil prosedur isi
End If
End With
End Sub
Private Sub TomEdit_Click()
NavigasiOn
Me.TomBatal.Enabled = True
Me.TomEdit.Enabled = False
Me.TomTambah.Enabled = False
Me.TomSimpan.Enabled = True
Me.TomHapus.Enabled = False
End Sub
Private Sub TomFirst_Click()
With Me.Adodc1.Recordset
If Not .BOF Then
.MoveFirst
Isi
End If
End With
End Sub
Private Sub TomHapus_Click()
On Error GoTo err
Me.Adodc1.Recordset.Delete
If Me.Adodc1.Recordset.BOF Then TomBatal_Click
Exit Sub
err:
End Sub
Private Sub TomLast_Click()
With Me.Adodc1.Recordset
If Not .BOF Then
.MoveLast
Isi
End If
End With
End Sub
Private Sub TomNext_Click()
With Me.Adodc1.Recordset
If Not .BOF Then
.MoveNext
If .EOF Then .MoveLast
Isi
End If
End With
End Sub
Private Sub TomPrevious_Click()
With Me.Adodc1.Recordset
If Not .EOF Then
.MovePrevious
If .BOF Then .MoveFirst
Isi
End If
End With
End Sub
Private Sub TomSimpan_Click()
On Error GoTo Error
With Me.Adodc1.Recordset
!Harga_Beli = Me.TBeli
!Harga_Jual = Me.TJual
!Kode = Me.TKode
!Nama_Barang = Me.TNama
!Persediaan = Me.TPersediaan
.Update
End With
MsgBox "Data Sudah Tersimpan.", vbInformation + vbOKOnly, "Informasi"
Error: 'jika terjadi error maka akan menjalankan proses CmdBatal_click
TomBatal_Click
End Sub
Private Sub TomTambah_Click()
NavigasiOff 'Navigasi ini terdapat di dalam tombol2 next,.....
KotakBuka
Me.TomBatal.Enabled = True
Me.TomEdit.Enabled = False
Me.TomTambah.Enabled = False
Me.TomSimpan.Enabled = True
Me.TomHapus.Enabled = False
Kosong
Me.Adodc1.Refresh
Me.Adodc1.Recordset.AddNew
End Sub
Private Sub TPersediaan_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
MsgBox "Yang dimasukkan harus angka !", vbInformation, "HarusAngka !"
End If
End Sub
Untuk Download Laporan diatas klik disini
0 komentar:
Posting Komentar