Buat Tabel Barang dengan MySQL :
CREATE TABLE `barang` (
`Kode_barang` char(5) NOT NULL,
`Nama_barang` varchar(80) NOT NULL,
`Harga_beli` int(11) NOT NULL,
`Harga_jual` int(11) NOT NULL,
`Stok` double NOT NULL,
PRIMARY KEY (`Kode_barang`)
) ENGINE=InnoDB DEFAULT CHARSET=latin1;
Kode Program Koneksi Add Module
Tambahkan pada proyek sebuah modul dengan nama “modulKoneksi”, sebagai koneksi ke database MySQL. ( Project Add Module ) ketikan sintaks program berikut :
Option Explicit
Public KonekDb As ADODB.Connection
Public Rs_Barang As ADODB.Recordset
Public Rs_BarangChg As ADODB.Recordset
Sub BukaDatabase()
Set KonekDb = New ADODB.Connection
KonekDb.ConnectionString = "" _
& "DRIVER={MYSQL ODBC 5.1 Driver};" _
& "SERVER=localhost;" _
& "DATABASE=edumdb;" _
& "UID=taufan;" _
& "PWD=075410070;" _
& "PORT=3306;"
On Error Resume Next
If KonekDb.State = adStateOpen Then
KonekDb.Close
Set KonekDb = New ADODB.Connection
KonekDb.Open
Else
KonekDb.Open
End If
If Err.Number <> 0 Then
MsgBox "Gagal Membuka database ", vbOKOnly, "Kesalahan"
End
Else
'MsgBox "Koneksi Sukses..!!!", vbInformation, "Pesan"
End If
Set Rs_Barang = New ADODB.Recordset
Rs_Barang.Open "SELECT * FROM barang order by Nama_barang", KonekDb, _
adOpenDynamic, adLockBatchOptimistic
End Sub
Kode Program Form Barang
Buat sebuah Form ( Project Add Form ) beri nama “FormBarang”, kemudian atur komponen” seperti pada gambar, ketikan kode program berikut :
Sub TombolNormal()
TbTambah.Enabled = True
TbSimpan.Enabled = False
TbUbah.Enabled = True
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
TbUbah.Caption = "Ubah"
TbKeluar.Caption = "Keluar"
End Sub
Sub FormMati()
CmbBarang.Enabled = False
TxtKdBrg.Enabled = False
TxtNmBrg.Enabled = False
TxtHrgBeli.Enabled = False
TxtHrgJual.Enabled = False
TxtStok.Enabled = False
End Sub
Sub FormHidup()
CmbBarang.Enabled = True
TxtKdBrg.Enabled = True
TxtNmBrg.Enabled = True
TxtHrgBeli.Enabled = True
TxtHrgJual.Enabled = True
TxtStok.Enabled = True
End Sub
Sub FormKosong()
CmbBarang.Text = ""
TxtKdBrg.Text = ""
TxtNmBrg.Text = ""
TxtHrgBeli.Text = ""
TxtHrgJual.Text = ""
TxtStok.Text = ""
End Sub
Sub FormNormal()
Call FormKosong ' panggil form kosong
Call FormMati ' panggil form tidak aktif
Call TombolNormal
TbKeluar.Caption = "Keluar"
LblJudul.Caption = "DATA BARANG"
CmbBarang.Visible = False
TxtKdBrg.Visible = True
End Sub
Sub AktifGridBarang()
With GridBarang
.Col = 0
.Row = 0
.Text = "KD BARANG"
.CellFontBold = True
.ColWidth(0) = 1400
.CellAlignment = flexAlignCenterCenter
.Col = 1
.Row = 0
.Text = "NAMA BARANG"
.CellFontBold = True
.ColWidth(1) = 2300
.CellAlignment = flexAlignCenterCenter
.Col = 2
.Row = 0
.Text = "HARGA BELI"
.CellFontBold = True
.ColWidth(2) = 1500
.CellAlignment = flexAlignCenterCenter
.Col = 3
.Row = 0
.Text = "HARGA JUAL"
.CellFontBold = True
.ColWidth(3) = 1500
.CellAlignment = flexAlignCenterCenter
.Col = 4
.Row = 0
.Text = "STOK"
.CellFontBold = True
.ColWidth(4) = 1000
.CellAlignment = flexAlignCenterCenter
End With
End Sub
Sub TampilGridBarang()
Dim BarisData As Integer
GridBarang.Clear
AktifGridBarang
GridBarang.Rows = 2
BarisData = 0
If Rs_Barang.BOF Then
Exit Sub
Else
Rs_Barang.MoveFirst
Do While Not Rs_Barang.EOF
BarisData = BarisData + 1
With GridBarang
.Rows = BarisData + 1
.TextMatrix(BarisData, 0) = Rs_Barang!Kode_barang
.TextMatrix(BarisData, 1) = Rs_Barang!Nama_barang
.TextMatrix(BarisData, 2) = Rs_Barang!Harga_beli
.TextMatrix(BarisData, 3) = Rs_Barang!Harga_jual
.TextMatrix(BarisData, 4) = Rs_Barang!Stok
End With
Rs_Barang.MoveNext
Loop
End If
End Sub
Private Sub Form_Load()
Move (Screen.Width - Width) / 2, _
(Screen.Height - Height) / 3
CmbBarang.Visible = False
Call FormMati ' mematikan form
Call TombolNormal
Call BukaDatabase
Call TampilGridBarang
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim intHeight As Integer
Dim i As Integer
intHeight = Me.Height \ 2
For i = 1 To intHeight
DoEvents
Me.Height = Me.Height - 60
Me.Top = (Screen.Height - Me.Height) \ 2
If Me.Height <= 500 Then Exit For
Next i
End Sub
Private Sub TbTambah_Click()
Call TampilGridBarang
Call FormHidup
TxtKdBrg.SetFocus
TbTambah.Enabled = False
TbSimpan.Enabled = True
TbUbah.Enabled = False
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
TbKeluar.Caption = "Batal"
LblJudul.Caption = "MENAMBAH BARANG BARU"
End Sub
Private Sub TbSimpan_Click()
If TxtNmBrg.Text = "" Then
MsgBox "Kolom Nama Masih Kosong", vbCritical, "Error"
TxtNmBrg.SetFocus
ElseIf TxtHrgBeli.Text = "" Then
MsgBox "Kolom Harga Beli kosong ", vbCritical, "Error"
TxtHrgBeli.SetFocus
ElseIf TxtHrgJual.Text = "" Then
MsgBox "Kolom Harga Jual kosong ", vbCritical, "Error"
TxtHrgJual.SetFocus
ElseIf TxtStok.Text = "" Then
MsgBox "Kolom Stok kosong ", vbCritical, "Error"
TxtStok.SetFocus
ElseIf Len(TxtKdBrg.Text) < 5 Then
MsgBox "Kode Barang Minimal 5 Digit!! misal: 'KB0001'", vbCritical, "Error"
TxtKdBrg.SetFocus
Else
sqlsimpan = ""
sqlsimpan = "INSERT INTO barang" _
& "(Kode_barang,Nama_barang,Harga_beli,Harga_jual,Stok)" _
& "VALUES ('" & TxtKdBrg.Text & "','" _
& TxtNmBrg.Text & "','" _
& TxtHrgBeli.Text & "','" _
& TxtHrgJual.Text & "','" _
& TxtStok.Text & "')"
KonekDb.Execute sqlsimpan, , adCmdText
Rs_Barang.Requery ' tambah record baru
Call TombolNormal
Call FormNormal
Call TampilGridBarang
MsgBox "Penyimpanan OK !", vbInformation, "Info"
TbTambah.SetFocus
End If
End Sub
Private Sub TbUbah_Click()
TbTambah.Enabled = False
TbSimpan.Enabled = False
TbUbah.Enabled = False
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
TbKeluar.Caption = "Batal"
Call FormKosong ' panggil form kosong
Call FormHidup
LblJudul.Caption = "PERBARUI DATA BARANG"
CmbBarang.Clear
CmbBarang.Visible = True
TxtKdBrg.Visible = False
Rs_Barang.Requery
With Rs_Barang
If .EOF And .BOF Then
MsgBox "Tabel Barang Kosong", vbCritical, "Error"
Else
CmbBarang.Clear
Do Until .EOF
CmbBarang.AddItem ![Kode_barang] _
& " | " & ![Nama_barang]
.MoveNext
Loop
.MoveFirst
End If
End With
End Sub
Private Sub CmbBarang_Click()
Dim SqlBarang As String
Call FormHidup ' Aktifkan form
TbTambah.Enabled = False
TbSimpan.Enabled = False
TbUbah.Enabled = False
TbUpdate.Enabled = True
TbHapus.Enabled = True
TbKeluar.Enabled = True
SqlBarang = ""
SqlBarang = "SELECT * FROM barang WHERE " _
& " Kode_barang ='" & Left(CmbBarang.Text, 5) & "'"
Set Rs_Barang = New ADODB.Recordset
Rs_Barang.Open SqlBarang, KonekDb, _
adOpenDynamic, adLockBatchOptimistic
With Rs_Barang
If .EOF And .BOF Then
MsgBox "Kode" + Left(CmbBarang.Text, 5) + "Tidak ada", _
vbCritical, "Perhatian"
Exit Sub
Else
TxtNmBrg.Text = !Nama_barang
TxtHrgBeli.Text = !Harga_beli
TxtHrgJual.Text = !Harga_jual
TxtStok.Text = !Stok
TxtNmBrg.SetFocus
End If
End With
End Sub
Private Sub TbUpdate_Click()
If TxtNmBrg.Text = "" Then
MsgBox "Kolom Nama Masih Kosong", vbCritical, "Error"
TxtNmBrg.SetFocus
ElseIf TxtHrgBeli.Text = "" Then
MsgBox "Kolom Harga Beli kosong ", vbCritical, "Error"
TxtHrgBeli.SetFocus
ElseIf TxtHrgJual.Text = "" Then
MsgBox "Kolom Harga Jual kosong ", vbCritical, "Error"
TxtHrgJual.SetFocus
ElseIf TxtStok.Text = "" Then
MsgBox "Kolom Stok kosong ", vbCritical, "Error"
TxtStok.SetFocus
Else
sqlubah = ""
sqlubah = "UPDATE barang " _
& " SET Nama_barang='" & TxtNmBrg.Text & "', " _
& " Harga_beli ='" & TxtHrgBeli.Text & "', " _
& " Harga_jual ='" & TxtHrgJual.Text & "', " _
& " Stok ='" & TxtStok.Text & "'" _
& " WHERE Kode_barang='" & Left(CmbBarang.Text, 5) & "'"
KonekDb.Execute sqlubah, , adCmdText
Rs_Barang.Requery
Call TombolNormal
Call FormNormal
Call TampilGridBarang
MsgBox "Perubahan telah disimpan !", vbInformation, "Info"
TbUbah.SetFocus
End If
End Sub
Private Sub TbHapus_Click()
If CmbBarang.Text = "" Then
MsgBox "Kode Barang belum dipilih", vbCritical, "Error"
Else
Konfirmasi = MsgBox("Yakin akan menghapus data ini ?", _
vbYesNo + vbCritical, "Penghapusan")
If Konfirmasi = vbYes Then
SqlHapus = ""
SqlHapus = "DELETE FROM barang WHERE " _
& " Kode_barang='" & Left(CmbBarang.Text, 5) & "'"
KonekDb.Execute SqlHapus, , adCmdText
Rs_Barang.Requery
CmbBarang.Clear
Call FormNormal
Call TampilGridBarang
Call TombolNormal
Else ' gagal menghapus
Call FormHidup
End If
End If
End Sub
Private Sub TbKeluar_Click()
If TbKeluar.Caption = "Batal" Then
Call FormMati
Call FormKosong
Call FormNormal
Call TombolNormal
Else
FormUtama.Enabled = True
Unload Me
End If
End Sub
Private Sub TxtKdBrg_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = vbKeyReturn Then
If Len(TxtKdBrg.Text) < 5 Then
MsgBox "Kode Barang Minimal 5 Digit!! misal: 'KB0001'", vbInformation
Else
TxtNmBrg.SetFocus
End If
End If
End Sub
Private Sub TxtNmbrg_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
TxtHrgBeli.SetFocus
KeyAscii = 0
End If
End Sub
Private Sub TxtHrgBeli_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
TxtHrgJual.SetFocus
KeyAscii = 0
ElseIf Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") _
Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub
Private Sub TxtHrgJual_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
TxtStok.SetFocus
KeyAscii = 0
ElseIf Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") _
Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub
Private Sub TxtStok_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
TbSimpan.SetFocus
KeyAscii = 0
ElseIf Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") _
Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub
