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
