Senin, 11 April 2016

free download vb6 source code examples program penjualan lengkap

free download vb6 source code examples program penjualan lengkap - kumpulan collection contoh source code visual basic 6.0 projects lengkap gratis. Mengingat sekarang ini sudah banyak program beredar di supermarket, toko, swalayan dan lain sebagainya, maka dari itu kita sebagai pengguna komputer program akan lebih baik kalau belajar membuat aplikasi sendiri. Adapun contoh program yang sering di pakai di bagian stap suatu instansi biasanya pengolahan data yakni ganti microsoft word.
free download vb6 source code examples program penjualan lengkap
free download vb6 source code examples program penjualan lengkap

free download vb6 source code examples program penjualan lengkap


Kali ini penulis berniat baik untuk membagikan coding program aplikasi penjualan barang elektronik komputer. silakan anda copy coding dibawah ini dengan nama file: menuutama Caption: Menu Utama, berikut codingnya:
 
Private Sub Form_Load()
Image1.Height = Me.ScaleHeight
Image1.Width = Me.ScaleWidth
Image1.Left = 0
Image1.Top = 0
End Sub
Private Sub Form_Resize()
Image1.Height = Me.ScaleHeight
Image1.Width = Me.ScaleWidth
Image1.Left = 0
Image1.Top = 0
End Sub
Private Sub IDBARANG_Click()
FIDBARANG.Show
End Sub
Private Sub IDJASA_Click()
FIDJASA.Show
End Sub
Private Sub IDKONSUMEN_Click()
FIDKONSUMEN.Show
End Sub
Private Sub KELUAR_Click()
On Error Resume Next
Dim question As String
question = MsgBox("Apakah anda yakin ingin keluar dari aplikasi ini.?", vbQuestion + vbYesNo, " Informasi")
If question = vbYes Then
Unload Me
End
End If
End Sub
Private Sub LPPENJUALANDANJASA_Click()
On Error GoTo salah
CrystalReport1.ReportFileName = App.Path + "\RDPenjualDJasa.rpt"
CrystalReport1.DataFiles(0) = App.Path + "\DATA.mdb"
CrystalReport1.RetrieveDataFiles
CrystalReport1.Destination = crptToWindow
CrystalReport1.WindowState = crptMaximized
CrystalReport1.Action = 1
salah:
Exit Sub
End Sub
Private Sub RDTRANSAKSI_Click()
On Error GoTo salah
CrystalReport1.ReportFileName = App.Path + "\RDTansaksi.rpt"
CrystalReport1.DataFiles(0) = App.Path + "\DATA.mdb"
CrystalReport1.RetrieveDataFiles
CrystalReport1.Destination = crptToWindow
CrystalReport1.WindowState = crptMaximized
CrystalReport1.Action = 1
salah:
Exit Sub
End Sub
Private Sub TRANSAKSI_Click()
FTRANSAKSI.Show
End Sub
Private Sub TRUKPEMBAYARAN_Click()
FLAPPORG.Show
End Sub



Bentuk tampilan dari menu utama seperti ini:

free download vb6 source code examples program penjualan lengkap
free download vb6 source code examples program penjualan lengkap

Selanjutnya buat lagi form dengan nama : IDKONSUMEN Caption: Input Data Konsumen,
 
Option Explicit
Dim kodeKONSUMEN As String
Sub BKTABLE()
Dim baris As Integer
tabel.Clear
tabel.Rows = 2
tabel.Cols = 4
tabel.FixedRows = 1
baris = 0
tabel.TextMatrix(0, 0) = "Kode Konsumen"
tabel.TextMatrix(0, 1) = "Nama Konsumen"
tabel.TextMatrix(0, 2) = "Alamat"
tabel.TextMatrix(0, 3) = "Telpon"
tabel.ColWidth(0) = 1500
tabel.ColWidth(1) = 2500
tabel.ColWidth(2) = 2500
tabel.ColWidth(3) = 1500
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open "Select * From KONSUMEN order by KDKONSUMEN", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsKONSUMEN.EOF
baris = baris + 1
tabel.Rows = baris + 1
tabel.TextMatrix(baris, 0) = RsKONSUMEN!KDKONSUMEN
tabel.TextMatrix(baris, 1) = RsKONSUMEN!NMKONSUMEN
tabel.TextMatrix(baris, 2) = RsKONSUMEN!Alamat
tabel.TextMatrix(baris, 3) = RsKONSUMEN!Telp
RsKONSUMEN.MoveNext
Loop
End Sub
Sub EMPT()
KDKONSUMEN.Text = ""
NMKONSUMEN.Text = ""
Alamat.Text = ""
Telp.Text = ""
End Sub
Sub FormMati()
NMKONSUMEN.Enabled = False
Alamat.Enabled = False
Telp.Enabled = False
End Sub
Sub FormHidup()
NMKONSUMEN.Enabled = True
Alamat.Enabled = True
Telp.Enabled = True
End Sub
Sub FormNormal()
Call EMPT
Call FormMati
CKoreksi.Enabled = False
CHapus.Enabled = False
CKeluar.Enabled = True
End Sub
Private Sub ALAMAT_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Simpan: EMPT
End Sub
Private Sub CKeluar_Click()
Unload Me
FMU.SetFocus
End Sub
Private Sub CHapus_Click()
Konfirmasi = MsgBox("Anda yakin akan " _
& " menghapus pesan ini?", _
vbYesNo + vbQuestion, "Konfirmasi")
If Konfirmasi = vbYes Then
SqlDelete = "DELETE FROM KONSUMEN WHERE " _
& " KDKONSUMEN='" & KDKONSUMEN.Text & "'"
connect.Execute SqlDelete, , adCmdText
RsKONSUMEN.Requery
Call FormNormal
Call Form_Load
CKeluar.Enabled = True
Else
Call FormNormal
End If
End Sub
Private Sub CKoreksi_Click()
If NMKONSUMEN.Text = "" Then
MsgBox "Nama KONSUMEN tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMKONSUMEN.SetFocus
ElseIf Alamat.Text = "" Then
MsgBox "ALAMAT KONSUMEN tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
Alamat.SetFocus
ElseIf Telp.Text = "" Then
MsgBox "Telepon tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
Telp.SetFocus
Else
SqlUpdate = "UPDATE KONSUMEN" _
& " SET NMKONSUMEN ='" & NMKONSUMEN.Text & "'," _
& " ALAMAT ='" & Alamat.Text & "', " _
& " TELP='" & Telp.Text & "' " _
& " WHERE KDKONSUMEN='" & KDKONSUMEN.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsKONSUMEN.Requery
Call FormNormal
MsgBox "Data telah ter_update dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
Call Form_Load: CKeluar.Enabled = True
End If
End Sub
Private Sub CTAMBAH_Click()
Call FormHidup
KDKONSUMEN.Enabled = True
Call BuatKodeKONSUMEN
KDKONSUMEN.Text = kodeKONSUMEN
CKoreksi.Enabled = False
CHapus.Enabled = False
CKeluar.Enabled = True
NMKONSUMEN.SetFocus
End Sub
Sub BuatKodeKONSUMEN()
RsKONSUMEN.Requery
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open "Select * From KONSUMEN ", _
connect, adOpenDynamic, adLockBatchOptimistic
If RsKONSUMEN.BOF Then
kodeKONSUMEN = "0001"
Exit Sub
Else
RsKONSUMEN.MoveLast
kodeKONSUMEN = RsKONSUMEN!KDKONSUMEN
kodeKONSUMEN = Right(kodeKONSUMEN, 4)
kodeKONSUMEN = Val(kodeKONSUMEN) + 1
If Len(kodeKONSUMEN) > 4 Then
MsgBox "Kode KONSUMEN Baru Melewati batas ", vbCritical, "ERROR"
Exit Sub
End If
End If
kodeKONSUMEN = "0" & Format(kodeKONSUMEN, "000")
End Sub
Sub Simpan()
If NMKONSUMEN.Text = "" Then
MsgBox "Nama KONSUMEN tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMKONSUMEN.SetFocus
ElseIf Alamat.Text = "" Then
MsgBox "ALAMAT KONSUMEN tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
Alamat.SetFocus
ElseIf Telp.Text = "" Then
MsgBox "Telepon KONSUMEN tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
Telp.SetFocus
Else
SqlInsert = "INSERT INTO KONSUMEN " _
& " (KDKONSUMEN ,NMKONSUMEN, ALAMAT, TELP)" _
& " VALUES('" & KDKONSUMEN.Text & "','" & NMKONSUMEN.Text & "','" & Alamat.Text & "','" & Telp.Text & "')"
connect.Execute SqlInsert, , adCmdText
RsKONSUMEN.Requery
Call FormNormal
Call Form_Load
MsgBox "Data telah tersimpan dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
End If
End Sub
Private Sub Form_Load()
Call BukaDatabase
CKoreksi.Enabled = False
CHapus.Enabled = False
Call FormMati
KDKONSUMEN.Enabled = False
FMU.Enabled = False
BKTABLE
End Sub
Private Sub Form_Unload(Cancel As Integer)
FMU.Enabled = True
End Sub
Private Sub KDKONSUMEN_Change()
Call FormHidup
CKoreksi.Enabled = True
CHapus.Enabled = True
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open " Select * from KONSUMEN " & " Where KDKONSUMEN ='" _
& KDKONSUMEN.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsKONSUMEN.EOF
On Error Resume Next
KDKONSUMEN.Text = RsKONSUMEN!KDKONSUMEN
NMKONSUMEN.Text = RsKONSUMEN!NMKONSUMEN
Alamat.Text = RsKONSUMEN!Alamat
Telp.Text = RsKONSUMEN!Telp
RsKONSUMEN.MoveNext
Loop
End Sub
Private Sub KDKONSUMEN_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then NMKONSUMEN.SetFocus
End Sub
Private Sub NMKONSUMEN_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Telp.SetFocus
End Sub
Private Sub Telp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Alamat.SetFocus
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = Asc("-")) Then KeyAscii = 0
End Sub


Bentuk Tampilan Formnya seperti ini:


Tampilan Form Input Data Konsumen
Tampilan Form Input Data Konsumen


Tambah form lagi dengan Name: idbarang dan Caption: Input Data Barang,
berikut codingnya:

 
Option Explicit
Dim KBR As String
Sub EMPT()
KBRG.Text = ""
NMBR.Text = ""
HRGBR.Text = ""
STNBR.Text = ""
MRKBR.Text = ""
STK.Text = ""
End Sub
Sub BKTABLE()
Dim baris As Integer
tabel.Clear
tabel.Rows = 2
tabel.Cols = 6
tabel.FixedRows = 1
baris = 0
tabel.TextMatrix(0, 0) = "Kode Barang"
tabel.TextMatrix(0, 1) = "Nama Barang"
tabel.TextMatrix(0, 2) = "Harga Barang"
tabel.TextMatrix(0, 3) = "Satuan Barang"
tabel.TextMatrix(0, 4) = "Merk Barang"
tabel.TextMatrix(0, 5) = "Stok"
tabel.ColWidth(0) = 1200
tabel.ColWidth(1) = 2500
tabel.ColWidth(2) = 1500
tabel.ColWidth(3) = 1000
tabel.ColWidth(4) = 1500
tabel.ColWidth(5) = 1000
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open "Select * From BARANG order by KDBARANG", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
baris = baris + 1
tabel.Rows = baris + 1
tabel.TextMatrix(baris, 0) = RsBARANG!KDBARANG
tabel.TextMatrix(baris, 1) = RsBARANG!NMBARANG
tabel.TextMatrix(baris, 2) = RsBARANG!HRGBARANG
tabel.TextMatrix(baris, 3) = RsBARANG!STNBARANG
tabel.TextMatrix(baris, 4) = RsBARANG!MRKBARANG
tabel.TextMatrix(baris, 5) = RsBARANG!Stok
RsBARANG.MoveNext
Loop
End Sub
Sub EASY()
Call EMPT
CKoreksi.Enabled = False
CKeluar.Enabled = True
End Sub
Private Sub CKeluar_Click()
Unload Me
FMU.SetFocus
End Sub
Private Sub CHapus_Click()
Konfirmasi = MsgBox("Anda yakin akan " _
& " menghapus pesan ini?", _
vbYesNo + vbQuestion, "Konfirmasi")
If Konfirmasi = vbYes Then
SqlDelete = "DELETE FROM BARANG WHERE " _
& " KDBARANG='" & KBRG.Text & "'"
connect.Execute SqlDelete, , adCmdText
RsBARANG.Requery
Call EASY
Call Form_Load
CKeluar.Enabled = True
Else
Call EASY
End If
End Sub
Private Sub CKoreksi_Click()
If NMBR.Text = "" Then
MsgBox "Nama Barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMBR.SetFocus
ElseIf HRGBR.Text = "" Then
MsgBox "Jenis Barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
HRGBR.SetFocus
ElseIf STNBR.Text = "" Then
MsgBox "STNBR barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
STNBR.SetFocus
Else
SqlUpdate = "UPDATE BARANG" _
& " SET NMBARANG='" & NMBR.Text & "'," _
& " HRGBARANG='" & HRGBR.Text & "', " _
& " STNBARANG='" & STNBR.Text & "', " _
& " MRKBARANG='" & MRKBR.Text & "', " _
& " STOK='" & STK.Text & "' " _
& " WHERE KDBARANG='" & KBRG.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsBARANG.Requery
Call EASY
MsgBox "Data telah ter_update dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
Call Form_Load: CKeluar.Enabled = True
End If
End Sub

Sub Simpan()
If NMBR.Text = "" Then
MsgBox "Nama Barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMBR.SetFocus
ElseIf HRGBR.Text = "" Then
MsgBox "Jenis Barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
HRGBR.SetFocus
ElseIf STNBR.Text = "" Then
MsgBox "STNBR Barang tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
STNBR.SetFocus
Else
SqlInsert = "INSERT INTO BARANG " _
& " (KDBARANG ,NMBARANG, HRGBARANG, STNBARANG,MRKBARANG,STOK)" _
& " VALUES('" _
& KBRG.Text & "','" _
& NMBR.Text & "','" _
& HRGBR.Text & "','" _
& STNBR.Text & "','" _
& MRKBR.Text & "','" _
& STK.Text & "')"
connect.Execute SqlInsert, , adCmdText
RsBARANG.Requery
Call EASY
Call Form_Load
MsgBox "Data telah tersimpan dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
End If
End Sub
Private Sub CTAMBAH_Click()
KBRG.Enabled = True
Call BKBR
KBRG.Text = KBR
CKoreksi.Enabled = False
CKeluar.Enabled = True
CHapus.Enabled = False
NMBR.SetFocus
End Sub
Sub BKBR()
RsBARANG.Requery
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open "Select * From BARANG order by KDBARANG", _
connect, adOpenDynamic, adLockBatchOptimistic
If RsBARANG.BOF Then
KBR = "0001"
Exit Sub
Else
RsBARANG.MoveLast
KBR = RsBARANG!KDBARANG
KBR = Right(KBR, 4)
KBR = Val(KBR) + 1
If Len(KBR) > 4 Then
MsgBox "Kode Barang Baru Melewati batas ", vbCritical, "ERROR"
Exit Sub
End If
End If
KBR = "0" & Format(KBR, "000")
End Sub
Private Sub Form_Load()
Call BukaDatabase
CHapus.Enabled = False
CKoreksi.Enabled = False
KBRG.Enabled = False
FMU.Enabled = False
Call BKTABLE
End Sub
Private Sub Form_Unload(Cancel As Integer)
FMU.Enabled = True
End Sub
Private Sub HRGBR_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then STNBR.SetFocus
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = Asc("-")) Then KeyAscii = 0
End Sub
Private Sub KBRG_Change()
CKoreksi.Enabled = True
CHapus.Enabled = True
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open " Select * from BARANG " & " Where KDBARANG ='" _
& KBRG.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
On Error Resume Next
KBRG.Text = RsBARANG!KDBARANG
HRGBR.Text = RsBARANG!HRGBARANG
NMBR.Text = RsBARANG!NMBARANG
STNBR.Text = RsBARANG!STNBARANG
MRKBR.Text = RsBARANG!MRKBARANG
STK.Text = RsBARANG!Stok
RsBARANG.MoveNext
Loop
End Sub
Private Sub KBRG_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then NMBR.SetFocus
End Sub
Private Sub MRKBR_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then STK.SetFocus
End Sub
Private Sub NMBR_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then HRGBR.SetFocus
End Sub
Private Sub STNBR_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then MRKBR.SetFocus
End Sub
Private Sub STK_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Simpan: EMPT
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = Asc("-")) Then KeyAscii = 0
End Sub

Tapilan Form Input Data Barang sebagai berikut:

Tapilan Form Input Data Barang
Tapilan Form Input Data Barang

Lanjut tambah lagi form dengan Name: idjasa Caption: Input Data Jasa.
 
Option Explicit
Dim KJS As String
Sub BKTABLE()
Dim baris As Integer
tabel.Clear
tabel.Rows = 2
tabel.Cols = 4
tabel.FixedRows = 1
baris = 0
tabel.TextMatrix(0, 0) = "Kode Jasa"
tabel.TextMatrix(0, 1) = "Nama Jasa"
tabel.TextMatrix(0, 2) = "Satuan Jasa"
tabel.TextMatrix(0, 3) = "Tarif Jasa"
tabel.ColWidth(0) = 1200
tabel.ColWidth(1) = 2500
tabel.ColWidth(2) = 1500
tabel.ColWidth(3) = 1000
Set RsJASA = New ADODB.Recordset
RsJASA.Open "Select * From JASA order by KDJASA", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
baris = baris + 1
tabel.Rows = baris + 1
tabel.TextMatrix(baris, 0) = RsJASA!KDJASA
tabel.TextMatrix(baris, 1) = RsJASA!NMJASA
tabel.TextMatrix(baris, 2) = RsJASA!STNJASA
tabel.TextMatrix(baris, 3) = RsJASA!TRFJASA
RsJASA.MoveNext
Loop
End Sub
Sub EMPT()
KDJS.Text = ""
NMJS.Text = ""
STJS.Text = ""
TRFJS.Text = ""
End Sub
Sub FormMati()
NMJS.Enabled = False
STJS.Enabled = False
TRFJS.Enabled = False
End Sub
Sub FormHidup()
NMJS.Enabled = True
STJS.Enabled = True
TRFJS.Enabled = True
End Sub
Sub FormNormal()
Call EMPT
Call FormMati
CKoreksi.Enabled = False
CKeluar.Enabled = True
End Sub
Private Sub CKeluar_Click()
Unload Me
FMU.SetFocus
End Sub
Private Sub CHapus_Click()
Konfirmasi = MsgBox("Anda yakin akan " _
& " menghapus pesan ini?", _
vbYesNo + vbQuestion, "Konfirmasi")
If Konfirmasi = vbYes Then
SqlDelete = "DELETE FROM JASA WHERE " _
& " KDJASA='" & KDJS.Text & "'"

connect.Execute SqlDelete, , adCmdText
RsJASA.Requery
Call FormNormal
Call Form_Load
CKeluar.Enabled = True
Else
Call FormNormal
End If
End Sub
Private Sub CKoreksi_Click()
If NMJS.Text = "" Then
MsgBox "Nama jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMJS.SetFocus
ElseIf STJS.Text = "" Then
MsgBox "satuan jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
STJS.SetFocus
ElseIf TRFJS.Text = "" Then
MsgBox "tarif jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
TRFJS.SetFocus
Else
SqlUpdate = "UPDATE JASA" _
& " SET NMJASA='" & NMJS.Text & "'," _
& " STNJASA='" & STJS.Text & "', " _
& " TRFJASA='" & TRFJS.Text & "' " _
& " WHERE KDJASA='" & KDJS.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsJASA.Requery
Call FormNormal
MsgBox "Data telah ter_update dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"

Call Form_Load: CKeluar.Enabled = True
End If
End Sub
Private Sub CTAMBAH_Click()
Call FormHidup
KDJS.Enabled = True
Call BuatKJS
KDJS.Text = KJS
CKoreksi.Enabled = False
CKeluar.Enabled = True
CHapus.Enabled = False
NMJS.SetFocus
End Sub
Sub BuatKJS()
RsJASA.Requery
Set RsJASA = New ADODB.Recordset
RsJASA.Open "Select * From JASA order by KDJASA", _
connect, adOpenDynamic, adLockBatchOptimistic
If RsJASA.BOF Then
KJS = "0001"
Exit Sub
Else
RsJASA.MoveLast
KJS = RsJASA!KDJASA
KJS = Right(KJS, 4)
KJS = Val(KJS) + 1
If Len(KJS) > 4 Then
MsgBox "Kode Barang Baru Melewati batas ", vbCritical, "ERROR"
Exit Sub
End If
End If
KJS = "0" & Format(KJS, "000")
End Sub
Sub Simpan()
If NMJS.Text = "" Then
MsgBox "Nama jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NMJS.SetFocus
ElseIf STJS.Text = "" Then
MsgBox "satuan jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
STJS.SetFocus
ElseIf TRFJS.Text = "" Then
MsgBox "tarif jasa tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
TRFJS.SetFocus
Else
SqlInsert = "INSERT INTO JASA " _
& " (KDJASA ,NMJASA, STNJASA, TRFJASA)" _
& " VALUES('" _
& KDJS.Text & "','" _
& NMJS.Text & "','" _
& STJS.Text & "','" _
& TRFJS.Text & "')"
connect.Execute SqlInsert, , adCmdText
RsJASA.Requery
Call FormNormal
Call Form_Load
MsgBox "Data telah tersimpan dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
End If
End Sub
Private Sub Form_Load()
Call BukaDatabase
CHapus.Enabled = False
CKoreksi.Enabled = False
Call FormMati
KDJS.Enabled = False
FMU.Enabled = False
Call BKTABLE
End Sub
Private Sub Form_Unload(Cancel As Integer)
FMU.Enabled = True
End Sub
Private Sub KDJS_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then NMJS.SetFocus
End Sub
Private Sub STJS_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TRFJS.SetFocus
End Sub
Private Sub KDJS_Change()
Call FormHidup
CKoreksi.Enabled = True
CHapus.Enabled = True
Set RsJASA = New ADODB.Recordset
RsJASA.Open " Select * from JASA " & " Where KDJASA ='" _
& KDJS.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
On Error Resume Next
KDJS.Text = RsJASA!KDJASA
STJS.Text = RsJASA!STNJASA
NMJS.Text = RsJASA!NMJASA
TRFJS.Text = RsJASA!TRFJASA
RsJASA.MoveNext
Loop
End Sub
Private Sub NMJS_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then STJS.SetFocus
End Sub
Private Sub TRFJS_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then Simpan: EMPT
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = Asc("-")) Then KeyAscii = 0
End Sub



Ini Tampilan Formnya:

Tampilan Input Form Data Jasa
Tampilan Input Form Data Jasa

Tambuh lagi form baru dengan Name: Transaksi dan Caption: Transaksi .
Berikut Codingnya:
 
Option Explicit
Dim KBR As String
Sub EMPT()
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
JLMBAYAR.Text = "0"
TTemp.Text = ""
KET.Text = "-"
End Sub
Sub BKONSUM()
RsTRANSAKSI.Requery
Set RsTRANSAKSI = New ADODB.Recordset
RsTRANSAKSI.Open "Select * From TRANSAKSI order by NOTRANSAKSI", _
connect, adOpenDynamic, adLockBatchOptimistic
If RsTRANSAKSI.BOF Then
KBR = "0001"
Exit Sub
Else
RsTRANSAKSI.MoveLast
KBR = RsTRANSAKSI!NOTRANSAKSI
KBR = Right(KBR, 4)
KBR = Val(KBR) + 1
If Len(KBR) > 4 Then
MsgBox "Kode Transaksi Out Of Line ", vbCritical, "Sorry"
Exit Sub
End If
End If
KBR = "0" & Format(KBR, "000")
End Sub
Sub MKTRANS()
Dim vntgjl As Variant
Dim vnDummy As Variant
CNOTRANSAKSI.Clear
Call BukaDatabase
RsTRANSAKSI.Requery
Set RsTRANSAKSI = New ADODB.Recordset
RsTRANSAKSI.Open "Select * From TRANSAKSI order by NOTRANSAKSI", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsTRANSAKSI.EOF
vntgjl = RsTRANSAKSI!NOTRANSAKSI
If IsNull(vntgjl) Then vntgjl = ""
CNOTRANSAKSI.AddItem CStr(vntgjl)
CNOTRANSAKSI.Text = CStr(vntgjl)
RsTRANSAKSI.MoveNext
Loop
End Sub
Sub MKKONSUMEN()
Dim vntgjl As Variant
Dim vnDummy As Variant
KDKONSUMEN.Clear
Call BukaDatabase
RsKONSUMEN.Requery
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open "Select * From KONSUMEN order by KDKONSUMEN", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsKONSUMEN.EOF
vntgjl = RsKONSUMEN!KDKONSUMEN
If IsNull(vntgjl) Then vntgjl = ""
KDKONSUMEN.AddItem CStr(vntgjl)
KDKONSUMEN.Text = CStr(vntgjl)
RsKONSUMEN.MoveNext
Loop
End Sub
Sub KMBARANG()
Dim vntgjl As Variant
Dim vnDummy As Variant
KDBARANG.Clear
Call BukaDatabase
RsBARANG.Requery
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open "Select * From BARANG order by KDBARANG", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
vntgjl = RsBARANG!KDBARANG
If IsNull(vntgjl) Then vntgjl = ""
KDBARANG.AddItem CStr(vntgjl)
KDBARANG.Text = CStr(vntgjl)
RsBARANG.MoveNext
Loop
KDBARANG.AddItem "-"
End Sub
Sub MAKEBARANG()
Dim vntgjl As Variant
Dim vnDummy As Variant
NMBARANG.Clear
Call BukaDatabase
RsBARANG.Requery
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open "Select * From BARANG order by NMBARANG", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
vntgjl = RsBARANG!NMBARANG
If IsNull(vntgjl) Then vntgjl = ""
NMBARANG.AddItem CStr(vntgjl)
NMBARANG.Text = CStr(vntgjl)
RsBARANG.MoveNext
Loop
NMBARANG.AddItem "-"
End Sub
Sub KMJASA()
Dim vntgjl As Variant
Dim vnDummy As Variant
KDJASA.Clear
Call BukaDatabase
RsJASA.Requery
Set RsJASA = New ADODB.Recordset
RsJASA.Open "Select * From JASA order by KDJASA", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
vntgjl = RsJASA!KDJASA
If IsNull(vntgjl) Then vntgjl = ""
KDJASA.AddItem CStr(vntgjl)
KDJASA.Text = CStr(vntgjl)
RsJASA.MoveNext
Loop
KDJASA.AddItem "-"
End Sub
Sub MAKEJASA()
Dim vntgjl As Variant
Dim vnDummy As Variant
NMJASA.Clear
Call BukaDatabase
RsJASA.Requery
Set RsJASA = New ADODB.Recordset
RsJASA.Open "Select * From JASA order by NMJASA", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
vntgjl = RsJASA!NMJASA
If IsNull(vntgjl) Then vntgjl = ""
NMJASA.AddItem CStr(vntgjl)
NMJASA.Text = CStr(vntgjl)
RsJASA.MoveNext
Loop
NMJASA.AddItem "-"
End Sub
Private Sub CHapus_Click()
Konfirmasi = MsgBox("Anda yakin akan " _
& " menghapus pesan ini?", _
vbYesNo + vbQuestion, "Konfirmasi")
If Konfirmasi = vbYes Then
SqlDelete = "DELETE FROM TRANSAKSI WHERE " _
& " NOTRANSAKSI='" & NOTRANSAKSI.Text & "'"
connect.Execute SqlDelete, , adCmdText
RsTRANSAKSI.Requery
Call Form_Load
CKeluar.Enabled = True
Else
End If
End Sub
Private Sub CKeluar_Click()
Unload Me
End Sub
Private Sub CKoreksi_Click()
If NOTRANSAKSI.Text = "" Then
MsgBox "NO Transaksi tidak boleh kosong!", _
vbInformation + vbOKOnly, "Perhatian"
NOTRANSAKSI.SetFocus
ElseIf KDKONSUMEN.Text = "" Then
MsgBox "Kode Konsumen belum dipilih!", _
vbInformation + vbOKOnly, "Perhatian"
KDKONSUMEN.SetFocus
ElseIf KDBARANG.Text = "" Then
MsgBox "Kode Barang belum dipilih", _
vbInformation + vbOKOnly, "Perhatian"
KDBARANG.SetFocus
ElseIf KDJASA.Text = "" Then
MsgBox "Kode Jasa belum dipilih", _
vbInformation + vbOKOnly, "Perhatian"
KDJASA.SetFocus
Else
SqlUpdate = "UPDATE TRANSAKSI" _
& " SET KDKONSUMEN='" & KDKONSUMEN.Text & "'," _
& " TGLTRANSAKSI='" & TGLTRANS.Text & "', " _
& " KDBARANG='" & KDBARANG.Text & "', " _
& " NMBARANG='" & NMBARANG.Text & "', " _
& " HRGBARANG='" & HRGBARANG.Text & "', " _
& " STOK='" & Stok.Text & "', " _
& " JMHBARANG='" & JMLBARANG.Text & "', " _
& " TOTHARGA='" & TOTHARGA.Text & "', " _
& " KDJASA='" & KDJASA.Text & "', " _
& " NMJASA='" & NMJASA.Text & "', " _
& " TRFJASA='" & TRFJASA.Text & "', " _
& " JLMTARIF='" & JLMTARIF.Text & "', " _
& " TOTTARIF='" & TOTTARIF.Text & "', " _
& " JMLBAYAR='" & JLMBAYAR.Text & "', " _
& " KET='" & KET.Text & "' " _
& " WHERE NOTRANSAKSI='" & NOTRANSAKSI.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsTRANSAKSI.Requery
MsgBox "Data telah ter_update dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
Call Form_Load: CKeluar.Enabled = True
End If
End Sub
Private Sub KDBARANG_Click()
NMBARANG.Text = "-"
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
JLMBAYAR.Text = "0"
KET.Text = "-"
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open " Select * from BARANG " & " Where KDBARANG ='" _
& KDBARANG.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
On Error Resume Next
KDBARANG.Text = RsBARANG!KDBARANG
NMBARANG.Text = RsBARANG!NMBARANG
HRGBARANG.Text = RsBARANG!HRGBARANG
Stok.Text = RsBARANG!Stok
KBRG.Text = RsBARANG!KDBARANG
NMBR.Text = RsBARANG!NMBARANG
HRGBR.Text = RsBARANG!HRGBARANG
STNBR.Text = RsBARANG!STNBARANG
MRKBR.Text = RsBARANG!MRKBARANG
STK.Text = RsBARANG!Stok
RsBARANG.MoveNext
Loop
If KDBARANG.Text = "-" Then
KDBARANG.Text = "-"
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
TOTHARGA.Text = "0"
KET.Text = "0"
End If
End Sub
Private Sub CSAVEAS_Click()
If KDKONSUMEN.Text = "" Then
KDKONSUMEN.Text = "-"
ElseIf JMLBARANG.Text = "" Then
KDBARANG.Text = "-"
NMBARANG.Text = "-"
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
ElseIf NMJASA.Text = "" Then
KDJASA.Text = "-"
NMJASA.Text = "-"
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
ElseIf KET.Text = "" Then
KET.Text = "-"
ElseIf JLMBAYAR.Text = "" Then
JLMBAYAR.SetFocus
Else
SqlInsert = "INSERT INTO TRANSAKSI " _
& " (NOTRANSAKSI,KDKONSUMEN,TGLTRANSAKSI,KDBARANG,NMBARANG,HRGBARANG,STOK,JMHBARANG,TOTHARGA,KDJASA,NMJASA,TRFJASA,JLMTARIF,TOTTARIF,JMLBAYAR,KET)" _
& " VALUES('" _
& NOTRANSAKSI.Text & "','" _
& KDKONSUMEN.Text & "','" _
& TGLTRANS.Text & "','" _
& KDBARANG.Text & "','" _
& NMBARANG.Text & "','" _
& HRGBARANG.Text & "','" _
& Stok.Text & "','" _
& JMLBARANG.Text & "','" _
& TOTHARGA.Text & "','" _
& KDJASA.Text & "','" _
& NMJASA.Text & "','" _
& TRFJASA.Text & "','" _
& JLMTARIF.Text & "','" _
& TOTTARIF.Text & "','" _
& JLMBAYAR.Text & "','" _
& KET.Text & "')"
connect.Execute SqlInsert, , adCmdText
RsTRANSAKSI.Requery
SqlUpdate = "UPDATE BARANG" _
& " SET NMBARANG='" & NMBR.Text & "'," _
& " HRGBARANG='" & HRGBR.Text & "', " _
& " STNBARANG='" & STNBR.Text & "', " _
& " MRKBARANG='" & MRKBR.Text & "', " _
& " STOK='" & STK.Text & "' " _
& " WHERE KDBARANG='" & KBRG.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsBARANG.Requery
EMPT
TGLTRANS.Text = TglSkrg(Date)
MKTRANS
KMBARANG
KMJASA
BKTABLE
FMU.Enabled = False
MAKEBARANG
MAKEJASA
MsgBox "Data telah tersimpan dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
End If
End Sub
Private Sub CSimpan_Click()
If KDKONSUMEN.Text = "" Then
KDKONSUMEN.SetFocus
Else
SqlInsert = "INSERT INTO TRANSAKSI " _
& " (NOTRANSAKSI,KDKONSUMEN,TGLTRANSAKSI,KDBARANG,NMBARANG,HRGBARANG,STOK,JMHBARANG,TOTHARGA,KDJASA,NMJASA,TRFJASA,JLMTARIF,TOTTARIF,JMLBAYAR,KET)" _
& " VALUES('" _
& NOTRANSAKSI.Text & "','" _
& KDKONSUMEN.Text & "','" _
& TGLTRANS.Text & "','" _
& KDBARANG.Text & "','" _
& NMBARANG.Text & "','" _
& HRGBARANG.Text & "','" _
& Stok.Text & "','" _
& JMLBARANG.Text & "','" _
& TOTHARGA.Text & "','" _
& KDJASA.Text & "','" _
& NMJASA.Text & "','" _
& TRFJASA.Text & "','" _
& JLMTARIF.Text & "','" _
& TOTTARIF.Text & "','" _
& JLMBAYAR.Text & "','" _
& KET.Text & "')"
connect.Execute SqlInsert, , adCmdText
RsTRANSAKSI.Requery
SqlUpdate = "UPDATE BARANG" _
& " SET NMBARANG='" & NMBR.Text & "'," _
& " HRGBARANG='" & HRGBR.Text & "', " _
& " STNBARANG='" & STNBR.Text & "', " _
& " MRKBARANG='" & MRKBR.Text & "', " _
& " STOK='" & STK.Text & "' " _
& " WHERE KDBARANG='" & KBRG.Text & "' "
connect.Execute SqlUpdate, , adCmdText
RsBARANG.Requery
EMPT
TGLTRANS.Text = TglSkrg(Date)
MKTRANS
KMBARANG
KMJASA
BKTABLE
FMU.Enabled = False
MAKEBARANG
MAKEJASA
MsgBox "Data telah tersimpan dalam database !", _
vbOKOnly + vbInformation, "Konfirmasi"
End If
End Sub
Private Sub CTAMBAH_Click()
BKONSUM
EMPT
NOTRANSAKSI.Text = KBR
AKTIFBUTTON
Frame2.Enabled = True
End Sub
Private Sub Form_Load()
EMPT
TGLTRANS.Text = TglSkrg(Date)
MKKONSUMEN
MKTRANS
KMBARANG
KMJASA
BKTABLE
FMU.Enabled = False
MAKEBARANG
MAKEJASA
End Sub
Private Sub Form_Unload(Cancel As Integer)
FMU.Enabled = True
End Sub
Private Sub JLMTARIF_Change()
TOTTARIF.Text = Val(JLMTARIF.Text) * Val(TRFJASA.Text)
End Sub
Private Sub JMLBARANG_Change()
If Val(JMLBARANG.Text) > Val(Stok.Text) Then
JMLBARANG.Text = "0"
Else
TOTHARGA.Text = Val(JMLBARANG.Text) * Val(HRGBARANG.Text)
STK.Text = Val(Stok.Text) - Val(JMLBARANG.Text)
End If
End Sub
Private Sub KDJASA_Click()
NMJASA.Text = "-"
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
Set RsJASA = New ADODB.Recordset
RsJASA.Open " Select * from JASA " & " Where KDJASA ='" _
& KDJASA.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
On Error Resume Next
KDJASA.Text = RsJASA!KDJASA
NMJASA.Text = RsJASA!NMJASA
TRFJASA.Text = RsJASA!TRFJASA
RsJASA.MoveNext
Loop
If KDJASA.Text = "-" Then
KDJASA.Text = "-"
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
End If
End Sub
Sub BKTABLE()
Dim baris As Integer
tabel.Clear
tabel.Rows = 2
tabel.Cols = 16
tabel.FixedRows = 1
baris = 0
tabel.TextMatrix(0, 0) = "No Transaksi"
tabel.TextMatrix(0, 1) = "Kode Konsumen"
tabel.TextMatrix(0, 2) = "Tanggal Transaksi"
tabel.TextMatrix(0, 3) = "Kode Barang"
tabel.TextMatrix(0, 4) = "Nama Barang"
tabel.TextMatrix(0, 5) = "Harga Barang"
tabel.TextMatrix(0, 6) = "Stok"
tabel.TextMatrix(0, 7) = "Jumlah Barang"
tabel.TextMatrix(0, 8) = "Total Harga"
tabel.TextMatrix(0, 9) = "Kode Jasa"
tabel.TextMatrix(0, 10) = "Nama Jasa"
tabel.TextMatrix(0, 11) = "Tarif Jasa"
tabel.TextMatrix(0, 12) = "Jumlah Tarif"
tabel.TextMatrix(0, 13) = "Total Tarif"
tabel.TextMatrix(0, 14) = "Jumlah Bayar"
tabel.TextMatrix(0, 15) = "Keterangan"
tabel.ColWidth(0) = 1500
tabel.ColWidth(1) = 1500
tabel.ColWidth(2) = 1500
tabel.ColWidth(3) = 1500
tabel.ColWidth(4) = 2500
tabel.ColWidth(5) = 1500
tabel.ColWidth(6) = 1000
tabel.ColWidth(7) = 1000
tabel.ColWidth(8) = 2000
tabel.ColWidth(9) = 2000
tabel.ColWidth(10) = 2000
tabel.ColWidth(11) = 2000
tabel.ColWidth(12) = 1500
tabel.ColWidth(13) = 1500
tabel.ColWidth(14) = 1500
tabel.ColWidth(15) = 2500
Set RsTRANSAKSI = New ADODB.Recordset
RsTRANSAKSI.Open "Select * From TRANSAKSI order by NOTRANSAKSI", _
connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsTRANSAKSI.EOF
baris = baris + 1
tabel.Rows = baris + 1
tabel.TextMatrix(baris, 0) = RsTRANSAKSI!NOTRANSAKSI
tabel.TextMatrix(baris, 1) = RsTRANSAKSI!KDKONSUMEN
tabel.TextMatrix(baris, 2) = RsTRANSAKSI!TGLTRANSAKSI
tabel.TextMatrix(baris, 3) = RsTRANSAKSI!KDBARANG
tabel.TextMatrix(baris, 4) = RsTRANSAKSI!NMBARANG
tabel.TextMatrix(baris, 5) = RsTRANSAKSI!HRGBARANG
tabel.TextMatrix(baris, 6) = RsTRANSAKSI!Stok
tabel.TextMatrix(baris, 7) = RsTRANSAKSI!JMHBARANG
tabel.TextMatrix(baris, 8) = RsTRANSAKSI!TOTHARGA
tabel.TextMatrix(baris, 9) = RsTRANSAKSI!KDJASA
tabel.TextMatrix(baris, 10) = RsTRANSAKSI!NMJASA
tabel.TextMatrix(baris, 11) = RsTRANSAKSI!TRFJASA
tabel.TextMatrix(baris, 12) = RsTRANSAKSI!JLMTARIF
tabel.TextMatrix(baris, 13) = RsTRANSAKSI!TOTTARIF
tabel.TextMatrix(baris, 14) = RsTRANSAKSI!JMLBAYAR
tabel.TextMatrix(baris, 15) = RsTRANSAKSI!KET
RsTRANSAKSI.MoveNext
Loop
End Sub
Private Sub KDKONSUMEN_Click()
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open " Select * from KONSUMEN" & " Where KDKONSUMEN ='" _
& KDKONSUMEN.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsKONSUMEN.EOF
On Error Resume Next
NMKONSUMEN.Text = RsKONSUMEN!NMKONSUMEN
RsKONSUMEN.MoveNext
Loop
End Sub
Private Sub NMBARANG_Click()
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
JLMBAYAR.Text = "0"
KET.Text = "-"
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open " Select * from BARANG " & " Where NMBARANG ='" _
& NMBARANG.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsBARANG.EOF
On Error Resume Next
KDBARANG.Text = RsBARANG!KDBARANG
HRGBARANG.Text = RsBARANG!HRGBARANG
Stok.Text = RsBARANG!Stok
KBRG.Text = RsBARANG!KDBARANG
NMBR.Text = RsBARANG!NMBARANG
HRGBR.Text = RsBARANG!HRGBARANG
STNBR.Text = RsBARANG!STNBARANG
MRKBR.Text = RsBARANG!MRKBARANG
STK.Text = RsBARANG!Stok
RsBARANG.MoveNext
Loop
If NMBARANG.Text = "-" Then
KDBARANG.Text = "-"
HRGBARANG.Text = "0"
Stok.Text = "0"
JMLBARANG.Text = "0"
TOTHARGA.Text = "0"
TOTHARGA.Text = "0"
KET.Text = "-"
End If
JMLBARANG.SetFocus
End Sub
Private Sub NMJASA_Click()
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
Set RsJASA = New ADODB.Recordset
RsJASA.Open " Select * from JASA " & " Where NMJASA ='" _
& NMJASA.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsJASA.EOF
On Error Resume Next
KDJASA.Text = RsJASA!KDJASA
NMJASA.Text = RsJASA!NMJASA
TRFJASA.Text = RsJASA!TRFJASA
RsJASA.MoveNext
Loop
If NMJASA.Text = "-" Then
KDJASA.Text = "-"
TRFJASA.Text = "0"
JLMTARIF.Text = "0"
TOTTARIF.Text = "0"
End If
TRFJASA.SetFocus
End Sub
Private Sub NOTRANSAKSI_Change()
EMPT
Set RsTRANSAKSI = New ADODB.Recordset
RsTRANSAKSI.Open " Select * from TRANSAKSI " & " Where NOTRANSAKSI ='" _
& NOTRANSAKSI.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsTRANSAKSI.EOF
On Error Resume Next
NOTRANSAKSI.Text = RsTRANSAKSI!NOTRANSAKSI
KDKONSUMEN.Text = RsTRANSAKSI!KDKONSUMEN
TGLTRANS.Text = RsTRANSAKSI!TGLTRANSAKSI
KDBARANG.Text = RsTRANSAKSI!KDBARANG
NMBARANG.Text = RsTRANSAKSI!NMBARANG
HRGBARANG.Text = RsTRANSAKSI!HRGBARANG
Stok.Text = RsTRANSAKSI!Stok
JMLBARANG.Text = RsTRANSAKSI!JMHBARANG
TOTHARGA.Text = RsTRANSAKSI!TOTHARGA
KDJASA.Text = RsTRANSAKSI!KDJASA
NMJASA.Text = RsTRANSAKSI!NMJASA
TRFJASA.Text = RsTRANSAKSI!TRFJASA
JLMTARIF.Text = RsTRANSAKSI!JLMTARIF
TOTTARIF.Text = RsTRANSAKSI!TOTTARIF
JLMBAYAR.Text = RsTRANSAKSI!JMLBAYAR
TTemp.Text = RsTRANSAKSI!JMLBAYAR
KET.Text = RsTRANSAKSI!KET
RsTRANSAKSI.MoveNext
Loop
AKTIFBUTTON
Frame2.Enabled = True
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open " Select * from KONSUMEN" & " Where KDKONSUMEN ='" _
& KDKONSUMEN.Text & "'" _
, connect, adOpenDynamic, adLockBatchOptimistic
Do While Not RsKONSUMEN.EOF
On Error Resume Next
NMKONSUMEN.Text = RsKONSUMEN!NMKONSUMEN
RsKONSUMEN.MoveNext
Loop
End Sub
Private Sub tabel_Click()
On Error GoTo make
NOTRANSAKSI.Text = CNOTRANSAKSI.Text
CNOTRANSAKSI.ListIndex = tabel.RowSel - 1
make:
End Sub
Private Sub TOTHARGA_Change()
JLMBAYAR.Text = Val(TOTHARGA.Text) + Val(TOTTARIF.Text)
End Sub
Private Sub TOTTARIF_Change()
JLMBAYAR.Text = Val(TOTHARGA.Text) + Val(TOTTARIF.Text)
End Sub
Sub AKTIFBUTTON()
If TTemp.Text = "" Then
CKoreksi.Enabled = False
CHapus.Enabled = False
CSimpan.Visible = True
CSAVEAS.Visible = False
Else
CKoreksi.Enabled = True
CHapus.Enabled = True
CSimpan.Visible = False
CSAVEAS.Visible = True
End If
End Sub




Berikut Tampilan Dari Form Transaksi:

Tampilan Dari Form Transaksi
Tampilan Dari Form Transaksi
Selanjutnya Anda klik Menu Project- klik Add Module, kemudian copy-paste kan coding dibawah ini:
 
Option Explicit
Public connect As New ADODB.Connection
Public RsKONSUMEN As ADODB.Recordset
Public RsBARANG As ADODB.Recordset
Public RsJASA As ADODB.Recordset
Public RsTRANSAKSI As ADODB.Recordset
Public RsJUALBRG As ADODB.Recordset
Public Rs As ADODB.Recordset
Public StrAkses As String
Public SqlInsert As String
Public SqlDelete As String
Public SqlUpdate As String
Public SQL As String
Public Konfirmasi As String
Public Sub BukaDatabase()
StrAkses = "Provider=Microsoft.Jet.OLEDB.4.0;Persist " _
& "Security Info=False;Data Source=" _
& App.Path + "\DATA.Mdb"
On Error Resume Next
If connect.State = adStateOpen Then
connect.Close
Set connect = New ADODB.Connection
connect.Open StrAkses
Else
connect.Open StrAkses
End If
Set RsKONSUMEN = New ADODB.Recordset
RsKONSUMEN.Open "SELECT * FROM KONSUMEN", connect, adOpenDynamic, adLockBatchOptimistic
Set RsBARANG = New ADODB.Recordset
RsBARANG.Open "SELECT * FROM BARANG", connect, adOpenDynamic, adLockBatchOptimistic
Set RsJASA = New ADODB.Recordset
RsJASA.Open "SELECT * FROM JASA", connect, adOpenDynamic, adLockBatchOptimistic
Set RsTRANSAKSI = New ADODB.Recordset
RsTRANSAKSI.Open "SELECT * FROM TRANSAKSI", connect, adOpenDynamic, adLockBatchOptimistic

Set RsJUALBRG = New ADODB.Recordset
RsJUALBRG.Open "SELECT * FROM JUALBRG", connect, adOpenDynamic, adLockBatchOptimistic
End Sub
Public Function TglSkrg(tgl As Date) As String
TglSkrg = Format(Day(tgl), "00") & "/" _
& Format(Month(tgl), "00") & "/" _
& Format(Year(tgl))
End Function
Public Function GetAppPath() As String
GetAppPath = IIf(Right$(App.Path, 1) = "\", App.Path, App.Path & "\")
End Function




Database pada program aplikasi ini seperti berikut:

Database
Database


Selanjutnya Tampilan Rekap Data Transaksi Penjualan seperti pada gambar dibawah ini:

Rekap Data Transaksi Penjualan
Rekap Data Transaksi Penjualan


Jika anda belum puas dengan artikel ini penulis mohon maaf, karen utnuk menjelaskan satu persatu secara rinci lumayan sulit. Jika anda menginginkan file project vb 6 secara lengkap, anda dapat menghubungi penulis di No HP: 0853-6789-7220.

Penulis akan meminta anda mengirim uang ke alamat rekening yang nantinya penulis tunjuk melalui no handphone. Nominal harga jasa dari aplikasi ini dapat di negosiasikan nantinya.

terima kasih telah berkunjung

Tidak ada komentar:

Posting Komentar

Popular Posts