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
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