Code Input Data Pembelian (Sistem Penjualan dan Pembelian Alat Optik)

Simpan Postingan

Pada posting kali ini admin akan melakukan sharing tentang kode program aplikasi penjualan dan pembelian alat optik.
Kode Program dibuat menggunakan Bahasa Pemrograman Visual Basic 6 dan database Ms.Access. Untuk lebih jelasnya berikut tampilan program form input data pembelian.

List code program sebagai berikut :

Dim dataasal As Database
Dim tabelasal As Recordset
Dim tabelcari1, tabelcari2, tabelcari3 As Recordset
Dim qcari1, qcari2 As Recordset
Dim isibaru As String
Dim tfi, tft As String
Private Sub Form_Load()
Set dataasal = OpenDatabase(App.Path & "\jualbeli.mdb")
Set tabelasal = dataasal.OpenRecordset("pembelian", dbOpenDynaset)
Set tabelcari1 = dataasal.OpenRecordset("suplier", dbOpenDynaset)
Set tabelcari2 = dataasal.OpenRecordset("barang", dbOpenDynaset)
Set tabelcari3 = dataasal.OpenRecordset("rincibeli", dbOpenDynaset)

Set qcari1 = dataasal.OpenRecordset("qbeli", dbOpenDynaset)
Set qcari2 = dataasal.OpenRecordset("qrbeli", dbOpenDynaset)
Set Data1.Recordset = qcari1
Set Data2.Recordset = qcari2
Set Data3.Recordset = tabelcari2
If tabelcari1.RecordCount > 0 Then
Do While tabelcari1.EOF = False
Combo1.AddItem tabelcari1("kdsup")
tabelcari1.MoveNext
Loop
End If
If tabelasal.RecordCount > 0 Then
tft = "True"
Call aturtombol(tft)
Call isiantampil
Call seleksirinci
Else
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
tutup.Enabled = True
Call isiankosong
End If
tfi = "False"
Call aturisian(tfi)
isibaru = "T"
Picture1.Visible = False
End Sub
Private Sub baru_Click()
Dim info, dasar, batasan As String
If baru.Caption = "&Baru" Then
baru.Caption = "&Simpan"
baru.ToolTipText = "Menyimpan Data"
rubah.Caption = "&Batal"
rubah.ToolTipText = "Membatalkan Data"
isibaru = "Y"
Call isiankosong
DBGrid1.Enabled = False
tfi = "True"
Call aturisian(tfi)
tft = "False"
Call aturtombol(tft)
Text7.Text = memkdkary
Text8.Text = memnmkary
baru.Enabled = True
rubah.Enabled = True
Text1.SetFocus
Else
If Text1.Text = " " Or Combo1.Text = " " Then
p = MsgBox("Nomor Nota atau kode suplier belum diisi...!", vbOKOnly + vbInformation, "Informasi")
Else
dasar = Text1.Text
batasan = "nobeli='" & dasar & "'"
tabelasal.FindFirst batasan
If tabelasal.NoMatch Then
tabelasal.AddNew
Call simpanisian
tabelasal.Update
Else
tabelasal.Edit
Call simpanisian
tabelasal.Update
End If
baru.Caption = "&Baru"
baru.ToolTipText = "Mengisi Data Baru"
rubah.Caption = "&Rubah"
rubah.ToolTipText = "Merubah Data"
tft = "True"
Call aturtombol(tft)
tfi = "False"
Call aturisian(tfi)
tabelasal.MoveLast
Set qcari1 = dataasal.OpenRecordset("qbeli", dbOpenDynaset)
Set Data1.Recordset = qcari1
DBGrid1.Enabled = True
DBGrid1.ReBind
isibaru = "T"
Picture1.Visible = False
End If
End If
End Sub
Private Sub isidetail_Click()
Dim info
If Text1.Text = " " Then
info = MsgBox("Nota beli belum diisi", 0 + 64, "Informasi")
Else
Picture1.Visible = True
Call bersihdetail
Text2.SetFocus
End If
End Sub
Private Sub OK_Click()
Dim info
Dim dasar1, dasar2, batasan
If Text10.Text = " " Then
info = MsgBox("Data barang belum terdaftar/dipilih", 0 + 64, "Informasi")
Text2.SetFocus
Else
dasar1 = Text1.Text
dasar2 = Text2.Text
batasan = "nobeli='" & dasar1 & "' and kdbrg='" & dasar2 & "'"
tabelcari3.FindFirst batasan
If tabelcari3.NoMatch Then
tabelcari3.AddNew
Call simpandetail
tabelcari3.Update
Else
tabelcari3.Edit
Call simpandetail
tabelcari3.Update
End If
Call tambahstok
Call bersihdetail
Text2.SetFocus
End If
End Sub
Private Sub rubah_Click()
If rubah.Caption = "&Rubah" Then
baru.Caption = "&Simpan"
baru.ToolTipText = "Menyimpan Data"
rubah.Caption = "&Batal"
rubah.ToolTipText = "Membatalkan Data"
tfi = "True"
Call aturisian(tfi)
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
rubah.Enabled = True
DTPicker1.SetFocus
Else
baru.Caption = "&Baru"
baru.ToolTipText = "Mengisi Data Baru"
rubah.Caption = "&Rubah"
rubah.ToolTipText = "Merubah Data"
If tabelasal.RecordCount > 0 Then
tft = "True"
Call aturtombol(tft)
Call isiantampil
Else
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
tutup.Enabled = True
Call isiankosong
End If
tfi = "False"
Call aturisian(tfi)
Set qcari1 = dataasal.OpenRecordset("qbeli", dbOpenDynaset)
Set Data1.Recordset = qcari1
DBGrid1.Enabled = True
isibaru = "T"
End If
End Sub
Private Sub hapus_Click()
Dim hapus
Dim dasar, batasan As String
hapus = MsgBox("Yakin akan dihapus ?", 4 + 32, "Konfirmasi")
If hapus = 6 Then
dasar = Text1.Text
batasan = "nobeli='" & dasar & "'"
tabelasal.FindFirst batasan
If tabelasal.NoMatch Then
MsgBox "Tidak ada data yang dihapus"
Else
tabelasal.Delete
End If
If tabelasal.RecordCount > 0 Then
tabelasal.MoveNext
Else
tabelasal.MoveFirst
End If
Set qcari1 = dataasal.OpenRecordset("qbeli", dbOpenDynaset)
Set Data1.Recordset = qcari1
DBGrid1.ReBind
End If
End Sub
Private Sub selesai_Click()
Call seleksirinci
Picture1.Visible = False
End Sub
Private Sub Text1_Change()
Call seleksirinci
End Sub
Private Sub Text14_Change()
Text16.Text = Val(Text14.Text) * Val(Text15.Text)
End Sub
Private Sub Text15_Change()
Text16.Text = Val(Text14.Text) * Val(Text15.Text)
End Sub
Private Sub Text2_Change()
Call caribarang
End Sub
Private Sub tutup_Click()
Unload Me
End Sub
Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If isibaru = "T" Then
Call isiantampil
End If
End Sub
Private Sub DBGrid3_DblClick()
Text2.Text = tabelcari2("kdbrg")
End Sub
Private Sub DBGrid3_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Text2.Text = tabelcari2("kdbrg")
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text1.Text)) > 10 Then
MsgBox ("Isian tidak valid, maksimal 10 karakter")
Text1.SetFocus
Else
DTPicker1.SetFocus
End If
End If
End Sub
Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo1.SetFocus
End If
End Sub
Private Sub DBGrid3_Click()
Text2.Text = tabelcari2("kdbrg")
Text15.SetFocus
End Sub
Private Sub combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
baru.SetFocus
End If
End Sub
Private Sub Combo1_Change()
Call carisuplier
End Sub
Private Sub Combo1_Click()
Call carisuplier
End Sub
Private Sub isiankosong()
Text1.Text = " "
DTPicker1.Value = Date
Combo1.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
End Sub
Public Sub simpanisian()
With tabelasal
!nobeli = Text1.Text
!tglbeli = DTPicker1.Value
!kdsup = Combo1.Text
!kdkary = Text7.Text
On Error GoTo 0
End With
End Sub
Public Sub isiantampil()
If qcari1.EOF = False Then
Text1.Text = qcari1("nobeli")
DTPicker1.Value = qcari1("tglbeli")
Combo1.Text = qcari1("kdsup")
Text3.Text = qcari1("nmsup")
Text4.Text = qcari1("almsup")
Text5.Text = qcari1("kotasup")
Text6.Text = qcari1("telpsup")
Text7.Text = qcari1("kdkary")
Text8.Text = qcari1("nmkary")
Else
Call isiankosong
End If
End Sub
Public Sub aturisian(tfi)
Text1.Enabled = tfi
DTPicker1.Enabled = tfi
Combo1.Enabled = tfi
End Sub
Public Sub aturtombol(tft)
baru.Enabled = tft
rubah.Enabled = tft
hapus.Enabled = tft
tutup.Enabled = tft
End Sub
Public Sub carisuplier()
Dim dasar, batasan As String
dasar = Combo1.Text
batasan = "kdsup='" & dasar & "'"
tabelcari1.FindFirst batasan
If tabelcari1.NoMatch Then
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Else
Text3.Text = tabelcari1("nmsup")
Text4.Text = tabelcari1("almsup")
Text5.Text = tabelcari1("kotasup")
Text6.Text = tabelcari1("telpsup")
End If
End Sub
Private Sub tutupisi_Click()
Picture1.Visible = False
End Sub
Public Sub caribarang()
Dim dasar, batasan As String
dasar = Text2.Text
batasan = "kdbrg='" & dasar & "'"
tabelcari2.FindFirst batasan
If tabelcari2.NoMatch Then
Text10.Text = " "
Text11.Text = " "
Text12.Text = " "
Text13.Text = " "
Text14.Text = 0
Else
Text10.Text = tabelcari2("jenis")
Text11.Text = tabelcari2("merek")
Text12.Text = tabelcari2("bahan")
Text13.Text = tabelcari2("model")
Text14.Text = tabelcari2("hargab")
Text15.SetFocus
End If
End Sub
Public Sub simpandetail()
With tabelcari3
!nobeli = Text1.Text
!kdbrg = Text2.Text
!jmlbeli = Text15.Text
!hargabeli = Text14.Text
On Error GoTo 0
End With
End Sub
Public Sub bersihdetail()
Text2.Text = " "
Text10.Text = " "
Text11.Text = " "
Text12.Text = " "
Text13.Text = " "
Text14.Text = 0
Text15.Text = 0
Text16.Text = 0
End Sub
Public Sub seleksirinci()
Dim vnota As String
Dim vsubtotal As Double
vsubtotal = 0
saring = "parameters vnota string;select * from qrbeli where trim(nobeli)=trim(vnota)"
Set tds = dataasal.CreateQueryDef("", saring)
tds.Parameters![vnota] = Text1.Text
Set tbs = tds.OpenRecordset()
Set Data2.Recordset = tbs
DBGrid1.ReBind
If tbs.RecordCount > 0 Then
tbs.MoveFirst
Do While tbs.EOF = False
vsubtotal = vsubtotal + (tbs("hargabeli") * tbs("jmlbeli"))
tbs.MoveNext
Loop
End If
Text9.Text = vsubtotal
Call simpantotal
End Sub

Public Sub tambahstok()
Dim dasar, batasan As String
dasar = Text2.Text
batasan = "kdbrg='" & dasar & "'"
tabelcari2.FindFirst batasan
If tabelcari2.EOF = False Then
tabelcari2.Edit
tabelcari2("stok") = tabelcari2("stok") + Val(Text15.Text)
tabelcari2.Update
End If
End Sub
Public Sub simpantotal()
Dim dasar, batasan
dasar = Text1.Text
batasan = "nobeli='" & dasar & "'"
tabelasal.FindFirst batasan
If tabelasal.EOF = False Then
tabelasal.Edit
tabelasal("tottrans") = Val(Text9.Text)
tabelasal.Update
End If
End Sub

Pemograman

September 16, 2015 • 0 komentar

T.I Sniper

Cara Dapat Backlink dengan Google Dork

Backlink dengan Google Dork Seo

FORUM

Cara Dapat Backlink Edu Gratis

Download File ISO Windows 11 Dan Bootable USB Rufus

Code Input Data Pembelian (Sistem Penjualan dan Pembelian Alat Optik)