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