Form Input Barang

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