LATIHAN SOAL

Listing Programnya:
Private Sub cmdclear_Click()
kodeoli = ""
jumlahbeli = ""
merkoli = ""
hargaoli = ""
pembayaran = ""
potongan = ""
ppn = ""
service = ""
totalbayar = ""
uangbayar = ""
uangkembali = ""
Combo1.Text = ""
Option1.Value = 0
Option2.Value = 0
End Sub

Private Sub cmdhitung_Click()
If Option1 Then
pembayaran = Val(jumlahbeli) * Val(hargaoli) + 5000
    Else
pembayaran = Val(jumlahbeli) * Val(hargaoli) + 3000
End If
If pembayaran > 80000 Then
potongan = 0.1 * Val(pembayaran)
Else
potongan = 0
End If
ppn = 0.5 * Val(pembayaran)
totalbayar = Val(pembayaran) - Val(potongan) + Val(ppn)

End Sub

Private Sub Combo1_Click()
Dim kode
kode = Combo1.Text
Select Case kode
Case "Penzoil"
    merkoli = "Penzoil"
    hargaoli = 35000
Case "Agip"
    merkoli = "Agip"
    hargaoli = 30000
Case "Top One"
    merkoli = "Top One"
    hargaoli = 27500
Case "4"
    merkoli = "Mesran"
    hargaoli = 20000
End Select


End Sub

Private Sub Form_Load()
Combo1.AddItem "Penzoil"
Combo1.AddItem "Agip"
Combo1.AddItem "Top One"

End Sub

Private Sub Option1_Click()
service = 5000

End Sub

Private Sub Option2_Click()
service = 3000
End Sub

Private Sub uangbayar_lostfocus()
uangkembali = Val(uangbayar) - Val(totalbayar)
End Sub

Contoh latihan:

Private Sub CMDDELETE_Click()
If MsgBox("Yakin Akan Hapus Data?", vbYesNo, "Info Azach") = vbYes Then
Data1.Recordset.Delete
Data1.Recordset.MoveFirst
End If
End Sub

Private Sub CMDEXIT_Click()
X = MsgBox("Yakin Akan Keluar??", vbOKCancel, "Bioskop 21 Nonstop")
If X = vbOK Then
End
End If
End Sub


Private Sub CMDNEW_Click()
TXTJUDUL = ""
TXTSTUDIO = ""
TXTHARGA = ""
TXTJB = ""
TXTJML = ""
TXTDISCOUNT = ""
TXTTOTAL = ""
Combo1.SetFocus
End Sub

Private Sub CMDSAVE_Click()
Data2.Recordset.AddNew
Data2.Recordset!Kd_Film = Combo1
Data2.Recordset!Judul = TXTJUDUL
Data2.Recordset!Studio = TXTSTUDIO
Data2.Recordset!Harga = TXTHARGA
Data2.Recordset!Jml_Beli = TXTJB
Data2.Recordset!Jumlah = TXTJML
Data2.Recordset!Discount = TXTDISCOUNT
Data2.Recordset!Total = TXTTOTAL
Data2.Recordset.Update
End Sub

Private Sub CMDSEARCH_Click()
X = InputBox("Silahkan Input Kode Film Yang Anda Cari!!", "Pencarian Data")
Data1.Recordset.Indeks = "KODE"
If Data1.Recordset.NoMatch Then
X = MsgBox("Data Tidak Ditemukan", vbInformation, "Pencarian Data")
End If
End Sub


Private Sub Combo1_Click()
Select Case Combo1.ListIndex
Case 0
TXTJUDUL = "BROWNIES"
TXTSTUDIO = 1
TXTHARGA = 20000
Case 1
TXTJUDUL = "EKSKUL"
TXTSTUDIO = 1
TXTHARGA = 22500
Case 2
TXTJUDUL = "HEART"
TXTSTUDIO = 1
TXTHARGA = 15000
Case 3
TXTJUDUL = "MISSION IMPOSIBLE"
TXTSTUDIO = 1
TXTHARGA = 25000
Case Else
TXTJUDUL = "RUMAH PONDOK INDAH"
TXTSTUDIO = 2
TXTHARGA = 17500
End Select
End Sub

Private Sub Form_Activate()
Combo1.AddItem "BR102"
Combo1.AddItem "EL102"
Combo1.AddItem "HR101"
Combo1.AddItem "MI101"
Combo1.AddItem "PI203"
End Sub

Private Sub TXTDISCOUNT_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TXTTOTAL = Val(TXTJML) - Val(TXTDISCOUNT)
End If
End Sub

Private Sub TXTJB_Change()
TXTJML = Val(TXTHARGA) * Val(TXTJB)
If Val(TXTJB) >= 10 Then
TXTDISCOUNT = 0.1 * Val(TXTJML)
ElseIf Val(TXTJB) >= 5 Then
TXTDISOUNT = 0.05 * Val(TXTJML)
Else
TXTDISCOUNT = 0
End If
End Sub

VISUAL BASIC

Listing Modul :

Public conn As ADODB.Connection
Public rsbarang As ADODB.Recordset
Public rstrans As ADODB.Recordset
Public rssmt As ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rsbarang = New ADODB.Recordset
Set rstrans = New ADODB.Recordset
Set rssmt = New ADODB.Recordset
conn.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=penjualan_12086546"
End Sub

Listing Form :

Dim a, b, c As Variant

Function totalharga()
Call koneksi
rssmt.Open "sementara", conn
rssmt.MoveFirst
ttotal = 0
Do While Not rssmt.EOF
ttotal = ttotal + rssmt!total
rssmt.MoveNext
Me.tjumbay = Format(ttotal, "#,###,###")
Loop
End Function

Function caridata()
Call koneksi
rsbarang.Open "select*from barang where kobar='" & tkobar & "'", conn
With rsbarang
If Not rsbarang.EOF Then
    Me.tnabar = !nabar
    Me.tharga = !harga
    c = !stok
    Me.tjumbel.SetFocus
Else
    MsgBox ("Data barang tidak ada!!!")
    tkobar = ""
    tkobar.SetFocus
End If
End With
End Function

Sub aktif()
tkobar.Enabled = True
Me.tjumbel.Enabled = True
Me.tubay.Enabled = True
End Sub
Sub nonaktif()
For Each x In Me
If TypeName(x) = "TextBox" Then
x.Enabled = False
End If
Next
End Sub

Sub bersih()
For Each x In Me
If TypeName(x) = "TextBox" Then
x.Text = ""
End If
Next
End Sub

Private Sub cbatal_Click()
Call koneksi
rssmt.Open "delete from sementara", conn
Form_Activate
Me.ctambah.Enabled = True
End Sub

Private Sub ckeluar_Click()
Unload Me
End Sub

Private Sub csimpan_Click()
On Error Resume Next
Dim SQLSimpan As String
Call koneksi
rssmt.Open "sementara", conn
rssmt.MoveFirst
    Do While Not rssmt.EOF
        If rssmt!kobar <> vbNullString Then
        rsbarang.Open "select*from barang where kobar='" & rssmt!kobar & "'", conn
        If Not rsbarang.EOF Then
            Dim kurangi As String
            kurangi = "update barang set stok='" & rsbarang!stok - rssmt!jumbel & "' where kobar='" & rssmt!kobar & "'"
            conn.Execute kurangi
        End If
    End If
  rssmt.MoveNext
  Loop
  rssmt.MoveFirst
  Do While Not rssmt.EOF
  SQLSimpan = "insert into transaksi values('" & tnofak & "','" & ttgl & "','" & rssmt!kobar & "','" & rssmt!jumbel & "','" & rssmt!total & "')"
  conn.Execute SQLSimpan
  rssmt.MoveNext
Loop
cbatal_Click
End Sub

Private Sub ctambah_Click()
aktif
bersih
Call koneksi
rstrans.Open "select*from transaksi order by nofak desc", conn
If rstrans.BOF Then
urutan = "0001"
Else
hitung = Trim(Str(Val(Right(rstrans!nofak, 4) + 1)))
        If Val(hitung) < 10 Then
        urutan = "000" + hitung
        ElseIf Val(hitung) < 100 Then
        urutan = "00" + hitung
        ElseIf Val(hitung) < 1000 Then
        urutan = "0" + hitung
        Else
        urutan = hitung
        End If
End If
tnofak = "F" + urutan
tkobar.SetFocus
tkobar.MaxLength = 5
ctambah.Enabled = False
csimpan.Enabled = True
cbatal.Enabled = True
End Sub

Private Sub Form_Activate()
Call koneksi
conn.CursorLocation = adUseClient
rssmt.Open "sementara", conn
With rssmt
If Not (.BOF And .EOF) Then
a = .Bookmark
End If
End With
Set DataGrid1.DataSource = rssmt.DataSource
bersih
nonaktif
Me.csimpan.Enabled = False
Me.cbatal.Enabled = False
Me.ctambah.Enabled = True
Me.ckeluar.Enabled = True
ctambah.SetFocus
End Sub


Private Sub Timer1_Timer()
ttgl = Format(Now, "yyyy-mm-dd")
If Label1.ForeColor = vbBlue Then
    Label1.ForeColor = vbYellow
Else
If Label1.ForeColor = vbYellow Then
    Label1.ForeColor = vbRed
Else
If Label1.ForeColor = vbRed Then
    Label1.ForeColor = vbWhite
Else
If Label1.ForeColor = vbWhite Then
    Label1.ForeColor = vbGreen
Else
If Label1.ForeColor = vbGreen Then
    Label1.ForeColor = vbBlack
Else
    Label1.ForeColor = vbBlue
End If
End If
End If
End If
End If
End Sub

Private Sub tjumbel_KeyPress(KeyAscii As Integer)
Dim total As Double
Dim SQLSementara As String
If KeyAscii = 13 Then
    If Val(tjumbel) > c Then
    MsgBox ("Jumlah Kurang,,Masukkan yang lebih kecil")
    tjumbel = ""
    tjumbel.SetFocus
    Else
    lagi = MsgBox("Ingin Tambah Data Lagi???", vbYesNo + vbQuestion, "TOKO DVD CITRA BUANA")
    If lagi = vbYes Then
    ttotal = ""
    ttotal = Val(tharga) * Val(tjumbel)
    SQLSementara = "insert into sementara values('" & tkobar & "','" & tnabar & "','" & Val(tjumbel) & "','" & Val(tharga) & "','" & Val(ttotal) & "')"
    conn.Execute SQLSementara
    DataGrid1.Refresh
    Call koneksi
    conn.CursorLocation = adUseClient
    rssmt.Open "sementara", conn
    Set DataGrid1.DataSource = rssmt.DataSource
    totalharga
    aktif
    tkobar = ""
    tnabar = ""
    tharga = ""
    tjumbel = ""
    tkobar.SetFocus
    Else
    ttotal = Val(tharga) * Val(tjumbel)
    SQLSementara = "insert into sementara values('" & tkobar & "','" & tnabar & "','" & Val(tjumbel) & "','" & Val(tharga) & "','" & Val(ttotal) & "')"
    conn.Execute SQLSementara
    DataGrid1.Refresh
    Call koneksi
    conn.CursorLocation = adUseClient
    rssmt.Open "sementara", conn
    Set DataGrid1.DataSource = rssmt.DataSource
    totalharga
    tubay.SetFocus
    End If
End If
End If
End Sub

Private Sub tkobar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
caridata
End If
End Sub

Private Sub tubay_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(tubay) < tjumbay Then
MsgBox " Uang Bayar Kurang.....!!!!"
tubay = ""
tubay.SetFocus
Else
tukem = Format(Val(tubay) - tjumbay, "#,###,###")
csimpan.SetFocus
End If
End If
End Sub