Aplikasi Sistem Informasi Penjualan Komputer Sistem Kredit
Aplikasi ini dibuat menggunakan visual basic 6.0 dengan link tabelnya pada microsoft Acces..berikut tampilan awalnya :
berikut link tabelnya :
form angsuran :
souce code data angsuran :
Private Sub cmdHapus_Click()
With Data1
If .Recordset.EOF And .Recordset.BOF Then Exit Sub
.Recordset.MoveLast
If MsgBox("Yakin akan dihapus?", vbYesNo + vbQuestion, "Konfirmasi") = vbYes Then
UpdateJual False, .Recordset(2)
.Recordset.Delete
End If
.Refresh
Hitung
Cek
End With
End Sub
Private Sub cmdPilihNoPenjualan_Click()
Unload Me
frmPilihPenjualan.Show
End Sub
Private Sub cmdProses_Click()
Dim StatOk As Boolean
With Data1
StatOk = True
For x = 0 To txtAngsuran.Count - 1
If txtAngsuran(x).Text = "" Then
MsgBox "Maaf " & lblAngsuran(x).Caption & " tidak boleh kosong", vbCritical, "Peringatan"
StatOk = False
txtAngsuran(x).SetFocus
Exit For
End If
Next
If StatOk = False Then Exit Sub
Txt2Data
UpdateJual True, txtAngsuran(2).Text
Hitung
Cek
End With
End Sub
Private Sub Data1_Reposition()
AdjustMasterGrid
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.Width = 10875
Me.Height = 7590
End Sub
Private Sub Form_Activate()
Dim x As Byte
PaintForm3D Me
txtAngsuran(1).Text = Format(Now, "dd-mm-yyyy")
Timer1.Enabled = True
ForceDetail
Hitung
Cek
End Sub
Private Sub Form_Load()
Set rc = DB.OpenRecordset("tblAngsuran", dbOpenDynaset)
Set Data1.Recordset = rc
Set rc = Nothing
Set rc = DB.OpenRecordset("tblPenjualan", dbOpenDynaset)
Set dtaPenjualan.Recordset = rc
Set rc = Nothing
End Sub
Private Sub Data2DetailJual()
With Data2
txtDetail(0).Text = .Recordset(0)
txtDetail(1).Text = .Recordset(1)
txtDetail(2).Text = .Recordset(2)
txtDetail(3).Text = .Recordset(3)
txtDetail(4).Text = .Recordset(4)
txtDetail(5).Text = .Recordset(5)
txtDetail(6).Text = .Recordset(6)
txtDetail(7).Text = .Recordset(7)
txtDetail(8).Text = ViewFormat(.Recordset(8))
txtDetail(9).Text = ViewFormat(.Recordset(9))
txtDetail(10).Text = ViewFormat(.Recordset(10))
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
txtAngsuran(2).Text = Format(txtAngsuran(2).Text, "###,###,###")
txtAngsuran(2).SelStart = Len(txtAngsuran(2).Text)
End Sub
Private Sub txtAngsuran_GotFocus(Index As Integer)
txtAngsuran(Index).BackColor = vbGreen
End Sub
Private Sub txtAngsuran_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
If Index = 0 Then Exit Sub
txtAngsuran(Index - 1).SetFocus
ElseIf KeyCode = 40 Or KeyCode = 13 Then
If Index = txtAngsuran.Count - 1 Then Exit Sub
txtAngsuran(Index + 1).SetFocus
End If
End Sub
Private Sub txtAngsuran_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 2 Then
If KeyAscii <> 57 Or KeyAscii = 8 Then
KeyAscii = 0
Beep
End If
End If
End Sub
Private Sub txtAngsuran_LostFocus(Index As Integer)
txtAngsuran(Index).BackColor = vbWhite
End Sub
Private Sub Txt2Data()
With Data1
.Recordset.AddNew
.Recordset(0) = txtAngsuran(0).Text
.Recordset(1) = txtAngsuran(1).Text
.Recordset(2) = DefaFormat(txtAngsuran(2).Text)
.Recordset.Update
End With
End Sub
Private Sub Hitung()
Dim TotAng As String
lblTotal.Caption = "0"
ForceDetail
With Data1
If .Recordset.EOF And .Recordset.BOF Then Exit Sub
.Recordset.MoveFirst
Do Until .Recordset.EOF
TotAng = Val(TotAng) + Val(.Recordset(2))
.Recordset.MoveNext
Loop
lblTotal.Caption = ViewFormat(TotAng)
End With
End Sub
Private Sub AdjustMasterGrid()
With DBGrid1
.Columns(0).Width = 800
.Columns(1).Width = 1500
.Columns(2).Width = 1700
End With
End Sub
Private Sub ForceDetail()
Dim SQL As String
SQL = "SELECT tblKonsumen.Nama,tblKonsumen.ID,"
SQL = SQL & "tblBarang.NamaBarang,tblBarang.Processor,tblBarang.Storage,tblBarang.Memory,tblBarang.VGA,tblBarang.OpticalDrive,"
SQL = SQL & "tblPenjualan.Harga,tblPenjualan.Terbayar,tblPenjualan.Sisa "
SQL = SQL & "FROM tblKonsumen,tblBarang,tblPenjualan "
SQL = SQL & "WHERE tblPenjualan.KodeKonsumen=tblKonsumen.KodeKonsumen "
SQL = SQL & "AND tblPenjualan.KodeBarang=tblBarang.KodeBarang "
SQL = SQL & "AND tblPenjualan.NoPenjualan='" & txtAngsuran(0).Text & "'"
Set rc = DB.OpenRecordset("tblAngsuran", dbOpenDynaset)
Set Data2.Recordset = rc
Data2.RecordSource = SQL
Set rc = Nothing
DoEvents
Data2.Refresh
Data2DetailJual
Data1.RecordSource = "SELECT * FROM tblAngsuran WHERE NoPenjualan='" & txtAngsuran(0).Text & "'"
Data1.Refresh
End Sub
Private Sub UpdateJual(ByVal DiBayar As Boolean, Nilai As String)
Dim Harga As Double, Terbayar As Double, Sisa As Double
With dtaPenjualan
.RecordSource = "SELECT * FROM tblPenjualan WHERE NoPenjualan='" & txtAngsuran(0).Text & "'"
.Refresh
If DiBayar = True Then
Harga = .Recordset(4)
Terbayar = .Recordset(5)
Terbayar = Terbayar + Val(DefaFormat(Nilai))
Sisa = Harga - Terbayar
Else
Harga = .Recordset(4)
Terbayar = .Recordset(5)
Terbayar = Terbayar - Val(DefaFormat(Nilai))
Sisa = Harga - Terbayar
End If
.Recordset.Edit
.Recordset(5) = Terbayar
.Recordset(6) = Sisa
.Recordset.Update
.Refresh
End With
End Sub
Private Sub Cek()
If DefaFormat(lblTotal.Caption) = DefaFormat(txtDetail(8).Text) And lblTotal.Caption <> "0" Then
cmdProses.Enabled = False
Else
cmdProses.Enabled = True
End If
End Sub
Di dalam aplikasi ini ada 6 form kalo di tampilkan semua panjang postingnya kalo mau coba download aja gratis disini..
berikut ikon seluruh program :
jika berminat mendapatkan Aplikasi ini Silahkan download diSini
4 komentar:
mas saya dah coba programnya, tapi muncul eror:
run time error '91':
object variable or with block variable not set.
trus ktika di klik Debug langsung emnunjuk ke baris:
Private Sub Form_Load()
Set rc = DB.OpenRecordset("tblPenjualan", dbOpenDynaset)
Set Data1.Recordset = rc
Set rc = Nothing
End Sub
mas tolong kirim flow map nya kalo bisa ke e-mail: pauzi04@gmail.com
terima kasih, semoga bermanfaat ilmunya.
mas bisa tolong kirim flow map nya ke e-mail: pauzi04@gmail.com
terima kasih semoga ilmunya bermanfaat.
thanks ya mas.oy,tolong donk mas ane dikirimin tutor lengkapx via email ( erdhyfikom@gmail.com ) yg ext *.doc,czx tugas akhir ane jg beginian mas,tp judulnya PERANCANGAN APPLIKASI PENJUALAN KOMPUTER & AKSESORIES KOMPUTER PADA TOKO XXXX MENGGUKAN VISUAL BASIC 6.0, sistem pembayarannya tunai mas.tolongin ane yaa mass,czx ane dh bikin jg,tp error2 mulu,mw private ortu lg gulung tikar nii mas.ane harepp bngt mas mau bantuin yaaa,mksh.....
Posting Komentar