• Beranda
  • Autosultan
  • Bitcoin
  • Dollar
  • Linux
  • LOKER
  • Printer
  • Sofware
  • sosial
  • TISniper
  • Virus
  • Windows

T.I Sniper

#Expert Advisor for MetaTrader 4 #Expert Advisor for MetaTrader 5 #youtube #google #free dollar business every day #Lowongan #Pekerjaan #Loker #forex #trading Autopilot #mining crypto #Update #Tutorial #Komputer Perbaikan, #Email #Facebook , #whatsapp ,#instagram #telegram ,#Internet ,#Motivasi , #Crypto , #AirDrop, #Bitcoin, #Ethereum, #Binance coin, #Cardano, #Degocoin, #Litecoin #Indodax, #Coinbase, #Nexo Dan Mata Uang Digital Lain , #Website, Perbaikan #Server #Domain , #Hosting, #Whm

    • Beranda
    • Contact Forum
    • Coffee JKs88
    • Tentang Kami
    • Parse Code Html
    • Text Terbalik
    • Privacy Policy

    Ikuti Kami!

    Follow Akun Instagram Kami Dapatkan Notifikasi Terbaru!
    Ikuti Kami di Facebok! Untuk mendapatkan notifikasi terbaru.

    Postingan Populer

    Backlink dengan Google Dork Seo

    Dork Seo
    Januari 01, 2016
    0

    Cara Dapat Backlink dengan Google Dork

    Dork Seo
    Februari 13, 2016
    0

    Cara Dapat Backlink Edu Gratis

    Seo
    Februari 13, 2016
    0

    Download File ISO Windows 11 Dan Bootable USB Rufus

    Sofware Windows
    Desember 02, 2021
    0

    FORUM 

    FORUM
    Desember 31, 2021
    0
    Author
    chmood
    Tautan disalin ke papan klip!
    Share Posts "Code Input Data Pembelian (Sistem Penjualan dan Pembelian Alat Optik)"
  • Salin link
  • Simpan Ke Daftar Bacaan
  • Bagikan ke Facebook
  • Bagikan ke Twitter
  • Bagikan ke Pinterest
  • Bagikan ke Telegram
  • Bagikan ke Whatsapp
  • Bagikan ke Tumblr
  • Bagikan ke Line
  • Bagikan ke Email
  • HomePemogramanCode Input Data Pembelian (Sistem Penjualan dan Pembelian Alat Optik)
    Code Input Data Pembelian (Sistem Penjualan dan Pembelian Alat Optik)

    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
    Disclaimer: gambar, artikel ataupun video yang ada di web ini terkadang berasal dari berbagai sumber media lain. Hak Cipta sepenuhnya dipegang oleh sumber tersebut. Jika ada masalah terkait hal ini, Anda dapat menghubungi kami di halaman ini.
    Isi dari komentar adalah tanggung jawab dari pengirim. T.I Sniper mempunyai hak untuk tidak memperlihatkan komentar yang tidak etis atau kasar. Jika ada komentar yang melanggar aturan ini, tolong dilaporkan.

    T.I Sniper

    Your description here

    • Follow
    • Autosultan
    • Wa Admin Bisnis
    Copyright ©2010 - 2022 🔥 T.I Sniper.
    • Beranda
    • Cari
    • Posting
    • Trending
    • Tersimpan