Sunday, April 14, 2013

form transaksi


1. Desain form sebagai berikut



1. Tambahkan Skrip Module


Public conn As ADODB.Connection

Public rsbarang As ADODB.Recordset

Public rspelanggan As ADODB.Recordset

Public rsdetail_penjualan As ADODB.Recordset

Public rspenjualan As ADODB.Recordset







Public Sub bukadatabases()

Set conn = New ADODB.Connection

Set rsbarang = New ADODB.Recordset

Set rspelanggan = New ADODB.Recordset

Set rsdetail_penjualan = New ADODB.Recordset

Set rspenjualan = New ADODB.Recordset

conn.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=dsbarang"

End Sub







2. Tambahkan skrip form



Dim mvbookmark As Variant



Private Sub bersih()

Text1.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text8.Text = ""

Text9.Text = 0

Text10.Text = 0

Text11.Text = 0

Text12.Text = 0

Text13.Text = 0

Text14.Text = ""

Text2.Enabled = False

Text3.Enabled = False

Text5.Enabled = False

Text6.Enabled = False

Text8.Enabled = False

Text9.Enabled = False

Text13.Enabled = False

Text14.Enabled = False

End Sub







Private Sub Form_Load()

bersih

AutoNomor

End Sub







Private Sub Text12_Change()

Dim Total, uangbayar, uangkembali As Currency

On Error Resume Next



If Text12.Text = "0" Or Text11.Text = "0" Then

Text13.Text = "0"

Exit Sub

Else



uangbayar = Format(Text12.Text, "00")

uangkembali = uangbayar - Text11.Text

Text13.Text = Format(uangkembali, "##,##0")



End If

End Sub



Private Sub Timer1_Timer()

Text3.Text = Time

Text2.Text = Format(Date, "YYYY/mm/dd")

End Sub





Function caridatapelanggan()

Call bukadatabases

rspelanggan.Open "Select * from pelanggan where kd_plgn='" & Text4 & "'", conn

End Function

Private Sub TampilkanDatapelanggan()

With rspelanggan

If Not rspelanggan.EOF Then

Text5 = rspelanggan!nama

Text6 = rspelanggan!alamat

End If

End With

End Sub



Private Sub Text4_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

Call caridatapelanggan

If Not rspelanggan.EOF Then

TampilkanDatapelanggan

Text7.SetFocus

Else

MsgBox " Data pelanggan tidak diketemukan"

Text8.Text = ""

Text9.Text = 0

Text7.SetFocus

End If



End If

End Sub





Function caridatabarang()

Call bukadatabases

rsbarang.Open "Select * from barang where kd_barang='" & Text7 & "'", conn

End Function













Private Sub TampilkanDatabarang()

With rsbarang

If Not rsbarang.EOF Then

Text8 = rsbarang!nama

Text9 = rsbarang!harga_jual

End If

End With

End Sub





Private Sub Text7_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 13 Then

Call caridatabarang

If Not rsbarang.EOF Then

TampilkanDatabarang

Text10.SetFocus

Else

MsgBox "Kode barang tidak diketemukan"

Text8.Text = ""

Text9.Text = 0

Text7.SetFocus

End If

End If

End Sub





Private Sub Form_Activate()

Call bukadatabases

conn.CursorLocation = adUseClient

rsdetail_penjualan.Open "SELECT detail_penjualan.kd_barang, barang.nama, detail_penjualan.qty, detail_penjualan.harga_jual, detail_penjualan.qty * detail_penjualan.harga_jual as total FROM detail_penjualan INNER JOIN barang ON detail_penjualan.kd_barang = barang.kd_barang where detail_penjualan.no_faktur='" & Text1 & "' ", conn

With rsdetail_penjualan

If Not (.BOF And .EOF) Then

mvbookmark = .Bookmark

End If

End With

Set DataGrid1.DataSource = rsdetail_penjualan.DataSource

Text4.SetFocus

End Sub



















Private Sub Command1_Click()

Dim sqltambah As String

sqltambah = "insert into detail_penjualan values ('" & Text1 & "','" & Text7 & "','" & Text10 & "','" & Text9 & "')"

conn.Execute sqltambah

Form_Activate

pesan = MsgBox("Apakah ada barang lagi ?", vbYesNo, "konfirmasi")

If pesan = vbYes Then

Text7.Text = ""

Text8.Text = 0

Text9.Text = 0

Text10.Text = 0

Text7.SetFocus

Call caritotal

Else

Text7.Text = ""

Text8.Text = 0

Text9.Text = 0

Text10.Text = 0

Text12.SetFocus

Call caritotal

End If

End Sub





Function caritotal()

Dim I As Integer

Dim totalkeseluruhan As Double

totalkeseluruhan = 0

DataGrid1.Col = 4

For I = 0 To DataGrid1.ApproxCount - 1

totalkeseluruhan = totalkeseluruhan + DataGrid1.Columns(4).CellValue(DataGrid1.GetBookmark(I))

Next

Text11.Text = totalkeseluruhan

End Function









Private Sub AutoNomor()

Call bukadatabases

rspenjualan.Open ("select * from penjualan Where no_faktur In(Select Max(no_faktur)From penjualan)Order By no_faktur Desc"), conn

rspenjualan.Requery

Dim urutan As String * 6

Dim hitung As Long

With rspenjualan

If .EOF Then

urutan = "1"

Text1.Text = urutan

Else

hitung = Right(!no_faktur, 3) + 1

urutan = Right("0" & hitung, 3)

Text1.Text = urutan

End If

Text1 = urutan

End With

End Sub



Private Sub SimpanData()

Dim sqlsimpan As String

sqlsimpan = "insert into penjualan values ('" & Text1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "','" & Text14 & "')"

conn.Execute sqlsimpan

End Sub



Private Sub Command2_Click()

Call SimpanData

pesan = MsgBox("ingin Cetak faktur", vbYesNo, "Konfirmasi")

If pesan = vbYes Then

Form4.Show

bersih

AutoNomor

Form_Activate

Else

bersih

AutoNomor

Form_Activate

End If

End Sub

0 komentar:

Post a Comment

Advertisement

 

Copyright 2008 All Rights Reserved Revolution Two Church theme by Brian Gardner Converted into Blogger Template by Bloganol dot com