Visual Basic ( Form Transaksi Kue ( Lanjutan Form Kue ) )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0 (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)

Listing Modul :


Public conn As New ADODB.Connection
Public rskue As New ADODB.Recordset
Public rstransaksi As New ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rskue = New ADODB.Recordset
Set rstransaksi = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bakery.mdb"
End Sub

Listing / Coding :

Sub auto()

Dim no As String

Dim noint As Integer

With rstransaksi

If .RecordCount = 0 Then

no = "0001"

Else

.MoveLast

noint = Val(Right(!notrans, 4)) + 1

no = Right("0000" & noint, 4)

End If

End With

txtnotrans.Text = no

End Sub

Sub aktif()

txtnotrans.Enabled = True

txtkode.Enabled = True

txtproduct.Enabled = True

txtjenis.Enabled = True

txtrasa.Enabled = True

txtharga.Enabled = True

txtjumbel.Enabled = True

txttobay.Enabled = True

txtbayar.Enabled = True

txtkembali.Enabled = True

End Sub

Sub nonaktif()

txtnotrans.Enabled = False

txtkode.Enabled = False

txtproduct.Enabled = False

txtjenis.Enabled = False

txtrasa.Enabled = False

txtharga.Enabled = False

txtjumbel.Enabled = False

txttobay.Enabled = False

txtbayar.Enabled = False

txtkembali.Enabled = False

End Sub

Sub bersih()

txtnotrans.Text = ""

txtkode.Text = ""

txtproduct.Text = ""

txtjenis.Text = ""

txtrasa.Text = ""

txtharga.Text = ""

txtjumbel.Text = ""

txttobay.Text = ""

txtbayar.Text = ""

txtkembali.Text = ""

End Sub

Sub tampil()

With rskue

If Not .EOF Then

txtkode.Text = !kdkue

txtproduct.Text = !product

txtjenis.Text = !jenis_kue

txtrasa.Text = !rasa_kue

txtharga.Text = !harga

End If

End With

End Sub

Private Sub Form_Load()

Call koneksi

conn.CursorLocation = adUseClient

rstransaksi.Open "select * from Transaksi", conn

Set gridtransaksi.DataSource = rstransaksi.DataSource

End Sub

Private Sub Form_Activate()

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = False

cmdcancel.Enabled = False

cmdexit.Enabled = True

cmdinput.Enabled = True

End Sub

Private Sub Timer1_Timer()

txttanggal.Text = Format(Date, "dd-mm-yyyy")

txttanggal.Enabled = False

End Sub

Private Sub cmdinput_Click()

aktif

bersih

auto

txtnotrans.Enabled = False

txtkode.SetFocus

cmdinput.Enabled = False

cmdsave.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdsave_Click()

Dim sqlsave As String

sqlsave = "insert into Transaksi values('" & txtnotrans.Text & "','" & txttanggal.Text & "','" & txtkode.Text & "','" & txtproduct & "','" & txtjenis.Text & "','" & txtrasa.Text & "','" & txtharga.Text & "','" & txtjumbel.Text & "','" & txttobay.Text & "')"

conn.Execute sqlsave

MsgBox "Data Telah Tersimpan"

Form_Load

nonaktif

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdcancel_Click()

p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

nonaktif

bersih

End If

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = False

cmddelete.Enabled = False

cmdexit.Enabled = True

End Sub

Private Sub cmddelete_Click()

Call koneksi

rstransaksi.Open "delete from Transaksi where notrans = '" & txtnotrans.Text & "'", conn

MsgBox "Data Telah Terhapus"

Form_Load

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdexit_Click()

p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

End

End If

End Sub

Private Sub txtkode_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call koneksi

rskue.Open "select * from Kue where kdkue = '" & txtkode.Text & "'", conn

If rskue.EOF Then

MsgBox "Kode Yang Anda Masukan Tidak Ada"

txtkode.Text = ""

txtkode.SetFocus

Else

tampil

txtjumbel.SetFocus

End If

End If

End Sub

Private Sub txtjumbel_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

txttobay.Text = Val(txtjumbel.Text) * Val(txtharga.Text)

txtbayar.SetFocus

End If

End Sub

Private Sub txtbayar_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

MsgBox "Terima Kasih"

txtkembali.Text = Val(txtbayar.Text) - Val(txttobay.Text)

nonaktif

cmdsave.SetFocus

End If

End Sub

Read More

Visual Basic ( Form Kue )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0  (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)

Listing Modul :

Public conn As New ADODB.Connection
Public rskue As New ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rskue = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bakery.mdb"
End Sub

Listing/Coding :


Sub aktif()
txtkode.Enabled = True
cmbproduct.Enabled = True
txtjenis.Enabled = True
lrasa.Enabled = True
txtharga.Enabled = True
End Sub

Sub nonaktif()
txtkode.Enabled = False
cmbproduct.Enabled = False
txtjenis.Enabled = False
lrasa.Enabled = False
txtharga.Enabled = False
End Sub

Sub bersih()
txtkode.Text = ""
cmbproduct.Text = "--Silakan Pilih--"
txtjenis.Text = ""
txtharga.Text = ""
End Sub

Sub tampil()
With rskue
If Not .EOF Then
txtkode.Text = !kdkue
cmbproduct.Text = !product
txtjenis.Text = !jenis_kue
lrasa.Text = !rasa_kue
txtharga.Text = !harga
End If
End With
End Sub

Private Sub Form_Load()
Call koneksi
conn.CursorLocation = adUseClient
rskue.Open "select * from Kue", conn
Set gridkue.DataSource = rskue.DataSource
End Sub

Private Sub Form_Activate()
nonaktif
bersih
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
cmddelete.Enabled = False
cmdinput.SetFocus
lrasa.Clear
cmbproduct.AddItem "Bread"
cmbproduct.AddItem "Cake"
cmbproduct.AddItem "Pastry"
End Sub

Private Sub cmdinput_Click()
aktif
bersih
lrasa.Clear
cmdinput.Enabled = False
cmdsave.Enabled = True
cmdedit.Enabled = True
cmdcancel.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
txtkode.SetFocus
End Sub

Private Sub cmdsave_Click()
If cmdsave.Caption = "&Save" Then
Dim sqlsave As String
sqlsave = "insert into Kue values('" & txtkode.Text & "','" & cmbproduct.Text & "','" & txtjenis.Text & "','" & lrasa.Text & "','" & txtharga.Text & "')"
conn.Execute sqlsave
MsgBox "Data Telah Tersimpan"
Form_Load
Else
Dim sqledit As String
sqledit = "update Kue set product = '" & cmbproduct & "',jenis_kue = '" & txtjenis.Text & "',rasa_kue = '" & lrasa.Text & "',harga = '" & txtharga.Text & "' where kdkue = '" & txtkode.Text & "'"
conn.Execute sqledit
MsgBox "Data Telah Diperbaharui"
Form_Load
End If
nonaktif
cmdsave.Enabled = True
cmdsave.Caption = "&Save"
cmdsave.Enabled = False
cmdinput.Enabled = True
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdedit_Click()
aktif
tampil
txtkode.Enabled = False
cmbproduct.SetFocus
cmdsave.Caption = "&Update"
cmdinput.Enabled = True
cmdedit.Enabled = False
cmdsave.Enabled = True
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdcancel_Click()
p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
nonaktif
bersih
End If
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
End Sub

Private Sub cmddelete_Click()
Call koneksi
rskue.Open "delete from Kue where kdkue = '" & txtkode.Text & "'", conn
MsgBox "Data Telah Terhapus"
Form_Load
bersih
nonaktif
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdexit_Click()
p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
End
End If
End Sub

Private Sub cmdtop_Click()
With rskue
rskue.MoveFirst
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdback_Click()
With rskue
rskue.MovePrevious
If rskue.BOF Then
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
rskue.MoveFirst
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdnext_Click()
With rskue
rskue.MoveNext
If rskue.EOF Then
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
rskue.MoveLast
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdbott_Click()
With rskue
rskue.MoveLast
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmbproduct_Click()
If cmbproduct.Text = "Bread" Then
txtjenis.Text = "Classic"
lrasa.Clear
lrasa.AddItem "Chocolate"
lrasa.AddItem "Keju"
lrasa.AddItem "Baso Keju"
ElseIf cmbproduct.Text = "Cake" Then
txtjenis.Text = "Taart"
lrasa.Clear
lrasa.AddItem "Black Forest"
lrasa.AddItem "Mocca Taart"
lrasa.AddItem "Lemon Taart"
Else
txtjenis.Text = "Pastry"
lrasa.Clear
lrasa.AddItem "Chiken Pie"
lrasa.AddItem "Danish Raisin"
lrasa.AddItem "Coissant Coklat"
End If
End Sub

Private Sub lrasa_Click()
If txtjenis.Text = "Classic" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "7000"
Else
txtharga.Text = "8000"
End If
ElseIf txtjenis.Text = "Taart" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "277000"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "215000"
Else
txtharga.Text = "215000"
End If
Else
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "6500"
Else
txtharga.Text = "6500"
End If
End If
End Sub

Read More

Visual Basic ( Form Majestyk Cake )

Coding/Listing :

Sub aktif()
txtkdkasir.Enabled = True
txtkdkue.Enabled = True
txtnmkue.Enabled = True
txtharga.Enabled = True
txtjenis.Enabled = True
txtstok.Enabled = True
txtjam.Enabled = True
txttanggal.Enabled = True
End Sub

Sub nonaktif()
txtkdkasir.Enabled = False
txtkdkue.Enabled = False
txtnmkue.Enabled = False
txtharga.Enabled = False
txtjenis.Enabled = False
txtstok.Enabled = False
txtjam.Enabled = False
txttanggal.Enabled = False
End Sub

Sub bersih()
txtkdkasir.Text = ""
txtkdkue.Text = ""
txtnmkue.Text = ""
txtharga.Text = ""
txtjenis.Text = ""
txtstok.Text = ""
End Sub


Private Sub Timer1_Timer()
txtjam.Text = Time
txttanggal.Text = Format(Date, "dd / mm / yy")
End Sub

Private Sub Form_Activate()
nonaktif
bersih
cmdtambah.Enabled = True
cmdtambah.SetFocus
End Sub

Private Sub cmdtambah_Click()
aktif
bersih
txtkdkasir.SetFocus
txtjam.Enabled = False
txttanggal.Enabled = False
End Sub

Private Sub txtkdkasir_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtkdkue.SetFocus
End If
End Sub

Private Sub cmdsimpan_Click()
With dtkue.Recordset
.AddNew
!kode_kue = txtkdkue.Text
!nama_kue = txtnmkue.Text
!jenis_kue = txtjenis.Text
!harga = txtharga.Text
!stok = txtstok.Text
.Update
.MoveLast
nonaktif
End With
End Sub

Private Sub cmdkeluar_Click()
p = MsgBox("Yakin Ingin Keluar...?!", vbQuestion + vbYesNo, "Konfirmasi")
If p = vbYes Then
End
End If
End Sub

Private Sub cmdtop_Click()
On Error Resume Next
dtkue.Recordset.MoveFirst
MsgBox "Data Sudah Diawal Record!", vbCritical, "Pesan"
End Sub

Private Sub cmdbott_Click()
On Error Resume Next
dtkue.Recordset.MoveLast
MsgBox "Data Sudah Diakhir Record!", vbCritical, "Pesan"
End Sub

Private Sub cmdback_Click()
On Error Resume Next
dtkue.Recordset.MovePrevious
If dtkue.Recordset.BOF Then
dtkue.Recordset.MoveFirst
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
End If
End Sub

Private Sub cmdnext_Click()
On Error Resume Next
dtkue.Recordset.MoveNext
If dtkue.Recordset.EOF Then
dtkue.Recordset.MoveLast
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
End If
End Sub

Read More

Latihan Untuk UAS..!!!

Untuk Programnya Bisa Download Disini....!!!
Untuk Listingnya Saja Bisa Download Disini...!!

Selamat Mencoba, Semoga Membantu...!! :D

Read More

Program Visual Basic Login

Tampilan :

Tabel User/Database:

Untuk Menampilakan DBGrid : Klik Kanan Pada Toolbox Kemudian Pilih Components Kemudian Pilih Microsoft Data Bound Grid Contorl 5.0(SP3)


Listing/Coding :


Option Explicit

Private Sub cmdlogin_Click()
On Error GoTo a
Data1.Recordset.Index = "xuser"
Data1.Recordset.Seek "=", txtuser
If Data1.Recordset!Password <> txtpass Then
MsgBox "Anda Salah Memasukkan Password", , "Info"
Else
Me.Hide
File_Master.Show
End If
Exit Sub
a:
MsgBox "Data Tidak Ada", , "Info"
txtuser.Text = ""
txtpass.Text = ""
End Sub

Private Sub cmdkeluar_Click()
Dim x As String
x = MsgBox("Are Your Sure To Exit..?!?", vbQuestion + vbYesNoCancel, "Informasi")
If x = vbYes Then
End
End If
End Sub

Read More