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
