Home contoh program vb 6 program aplikasi persediaan barang vb 6

Saturday, March 18, 2017

program aplikasi persediaan barang vb 6

Diterbitkan
Tags


Aplikasi persediaan barang VB 6.0

Program ini merupakan suatu ilustrasi tentang aplikasi persediaan barang yang dimulai dari pengolahan tabel master (barang, supplier, customer dan pengguna aplikasi) kemudian dilanjutkan dengan pengolahan tabel transaksi dimulai dari pengecekan stok barang minumum untuk dilaporkan ke bagian pembelian barang, penerimaan barang dari supplier, permintaan barang dari customer dan pengeluaran barang kepada customer. Setelah pengolahan data transaksi selesai maka dibuatlah laporan yang meliputi laporan tabel master dan laporan data transaksi.

3.1 Merancang Database Dan Bentuk Relasi Tabel

Dalam aplikasi persediaan barang ini desain database dan relasi tabel terlihat pada gambar  di bawah ini




 



3.3 Pengolahan Data Master








3.4 Transaksi







Private Sub Form_Activate()
Call Koneksi
Adodc1.ConnectionString = PathData
Adodc1.RecordSource = "select Nomor,Kode,Nama,Jumlah from TMPMintaBeli"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
Call Auto
TanggalMnt = Date
End Sub

'tampilkan angka 1 s/d 50 step 5
'di combo1
Private Sub Form_Load()
Call Koneksi
For i = 0 To 50 Step 5
    Combo1.AddItem i
Next i
CmdBatal_Click
End Sub

'cetak laporan permintaan
'barang dari gudang ke bagian pembelian
Sub CetakPermintaanBeli()
    CR.ReportFileName = App.Path & "\lap Minta Stok Barang.rpt"
    CR.WindowState = crptMaximized
    CR.RetrieveDataFiles
    CR.Action = 1
End Sub


Private Sub CmdTutup_Click()
Unload Me
End Sub

'menampilkan nomor permintaan otomatis
'berdasarkan tanggal
Private Sub Auto()
Call Koneksi
RSMintaBeli.Open "select * from PermintaanBeli Where NomorMnt In(Select Max(NomorMnt)From PermintaanBeli)Order By NomorMnt Desc", Conn
RSMintaBeli.Requery
Dim Urutan As String * 10
Dim Hitung As Long
With RSMintaBeli
    If .EOF Then
        Urutan = Format(Date, "yymmdd") + "0001"
        NomorMnt = Urutan
    Else
        If Left(!NomorMnt, 6) <> Format(Date, "yymmdd") Then
            Urutan = Format(Date, "yymmdd") + "0001"
        Else
            Hitung = (!NomorMnt) + 1
            Urutan = Format(Date, "yymmdd") + Right("0000" & Hitung, 4)
        End If
    End If
    NomorMnt = Urutan
End With
End Sub

'hapus isi tabel TMPMintabeli
Sub TabelKosong()
Call Koneksi
Dim hapus As String
hapus = "delete * from TMPMintaBeli"
Conn.Execute hapus
Form_Activate
End Sub

'tampilkan data hasil pencarian
'stok barang minimal ke dalam grid

Private Sub CmdTampilkan_Click()
If Combo1 = "" Then
    MsgBox "pilih jumlah barang minimal dalam combo"
    Combo1.SetFocus
    Exit Sub
Else
    Call TabelKosong
    'cari stok barang yang jumlahnya < dari jumlah
    'yang dipilih di combo
    RSBarang.Open "select * from barang where val(jumlahbrg)<=" & Val(Combo1) & "", Conn
    RSBarang.Requery
    If RSBarang.EOF Then
        MsgBox "data tidak ditemukan"
        Call TabelKosong
    Else
        RSBarang.MoveFirst
        Nomor = 0
        Do While Not RSBarang.EOF
            Nomor = Nomor + 1
            Adodc1.Recordset.AddNew
            Adodc1.Recordset!Nomor = Nomor
            Adodc1.Recordset!Kode = RSBarang!kodebrg
            Adodc1.Recordset!Nama = RSBarang!namabrg
            Adodc1.Recordset!JUMLAH = RSBarang!jumlahbrg
            Adodc1.Recordset.Update
            RSBarang.MoveNext
        Loop
        Call TotalItem
        TxtTotal.Enabled = False
    End If
End If
End Sub

Private Sub CmdSimpan_Click()
Call Koneksi
Dim simpan1 As String
'simpan data ke tabel Permintaanbeli (hanya sekali)
simpan1 = "insert into PermintaanBeli(nomormnt,tanggalmnt,totalmnt,kodepmk) values " & _
"('" & NomorMnt & "','" & TanggalMnt & "','" & TxtTotal & "','ADM1')"
Conn.Execute simpan1

'simpan data ke tabel DetailMintaBeli berulang-ulang
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF
    Dim simpan2 As String
    simpan2 = "insert into DetailMintaBeli(nomormnt,KODEBRG,QTYMNT) values " & _
    "('" & NomorMnt & "','" & Adodc1.Recordset!Kode & "','" & Adodc1.Recordset!JUMLAH & "')"
    Conn.Execute simpan2
Adodc1.Recordset.MoveNext
Loop
Form_Activate
Call TabelKosong
TxtTotal = ""
'panggil file Crystal report
Call CetakPermintaanBeli
End Sub

'mencari total item
Function TotalItem()
On Error Resume Next
Adodc1.Recordset.MoveFirst
Item = 0
Do While Not Adodc1.Recordset.EOF
    Item = Item + Adodc1.Recordset!JUMLAH
    Adodc1.Recordset.MoveNext
    TxtTotal = Item
Loop
End Function

Private Sub CmdBatal_Click()
Combo1 = ""
Call TabelKosong
TxtTotal = ""
End Sub





Private Sub Form_Activate()
Call Koneksi
ADO.ConnectionString = PathData
ADO.RecordSource = "TMPTerima"
ADO.Refresh
Set DG.DataSource = ADO
DG.Refresh
Call Auto
TanggalTrm = Date
Call TabelKosong
ADO.Recordset.MoveFirst
End Sub

'saat form di load..
'tampilkan kode supplier dalam combo
Private Sub Form_Load()
Call Koneksi
RSSupplier.Open "supplier", Conn
Combo1.Clear
Do While Not RSSupplier.EOF
    Combo1.AddItem RSSupplier!Kodespl
    RSSupplier.MoveNext
Loop
End Sub

'menampilkan nomor penerimaan otomatis
'berdasarkan tanggal
Private Sub Auto()
Call Koneksi
RSPenerimaan.Open "select * from Penerimaan Where NomorTrm In(Select Max(NomorTrm)From Penerimaan)Order By NomorTrm Desc", Conn
RSPenerimaan.Requery
Dim Urutan As String * 10
Dim Hitung As Long
With RSPenerimaan
    If .EOF Then
        Urutan = "TR" + Format(Date, "yymmdd") + "01"
        NomorTrm = Urutan
    Else
        If Mid(!NomorTrm, 3, 6) <> Format(Date, "yymmdd") Then
            Urutan = "TR" + Format(Date, "yymmdd") + "01"
        Else
            Hitung = Right(!NomorTrm, 2) + 1
            Urutan = "TR" + Format(Date, "yymmdd") + Right("00" & Hitung, 2)
        End If
    End If
    NomorTrm = Urutan
End With
End Sub

'dalam grid hanya dapat diisi angka
Private Sub dg_Keypress(Keyascii As Integer)
If DG.Col = 1 Then
    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack Or Keyascii = vbKeyReturn) Then Keyascii = 0
ElseIf DG.Col = 4 Then
    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack Or Keyascii = vbKeyReturn) Then Keyascii = 0
End If
End Sub


Private Sub CmdBatal_Click()
Combo1 = ""
TxtNomorBon = ""
LblTotal = ""
NamaSpl = ""
PersonSpl = ""
Call TabelKosong
Combo1.SetFocus
End Sub

Private Sub CmdTutup_Click()
Unload Me
End Sub

'menampilkan identitas supplier
'saat combo di klik
Private Sub COMBO1_Click()
Call Koneksi
RSSupplier.Open "select * from Supplier where kodespl='" & Combo1 & "'", Conn
If Not RSSupplier.EOF Then
    NamaSpl = RSSupplier!NamaSpl
    PersonSpl = RSSupplier!PersonSpl
Else
    MsgBox "Kode Supplier tidak terdaftar"
    Combo1.SetFocus
End If
End Sub

'kode supplier dalam combo dapat dipilih
'dan dapat diketik lalu menekan enter
Private Sub COMBO1_KeyPress(Keyascii As Integer)
Keyascii = Asc(UCase(Chr(Keyascii)))
If Keyascii = 13 Then
    If Combo1 = "" Then
        MsgBox "Kode supplier wajib diisi"
        Combo1.SetFocus
        Exit Sub
    ElseIf Combo1 <> "" Then
        Call Koneksi
        RSSupplier.Open "select * from supplier where kodespl='" & Combo1 & "'", Conn
        If Not RSSupplier.EOF Then
            COMBO1_Click
            TxtNomorBon.SetFocus
        Else
            MsgBox "Kode supplier tidak terdaftar"
            NamaSpl = ""
            PersonSpl = ""
            Combo1.SetFocus
            Combo1 = ""
            Exit Sub
        End If
    End If
End If
End Sub

Private Sub Command2_Click()
Total = ""
Combo1 = ""
NamaDpt = ""
PersonDpt = ""
Call TabelKosong
Combo1.SetFocus
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

'transaksi dalam grid
Private Sub DG_AfterColEdit(ByVal ColIndex As Integer)
    If DG.Col = 1 Then
        If Len(ADO.Recordset!Kode) < 3 Then
            MsgBox "Kode Harus 3 digit"
            DG.Col = 1
            Exit Sub
        End If
   
        Call Koneksi
        RSBarang.Open "Select * from Barang where KodeBrg='" & ADO.Recordset!Kode & "'", Conn
        'menampilkan data barang jika kodenya ditemukan
        If Not RSBarang.EOF Then
            ADO.Recordset!Kode = RSBarang!kodebrg
            ADO.Recordset!Nama = RSBarang!namabrg
            ADO.Recordset!Stokawal = RSBarang!jumlahbrg
            DG.Col = 4
            DG.Refresh
            Exit Sub
        End If
    End If
   
    If DG.Col = 4 Then
        ADO.Recordset!Diterima = ADO.Recordset!Diterima
        ADO.Recordset.Update
        ADO.Recordset.MoveNext
        DG.Col = 1
        Call TotalBarang
    End If
    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0
End Sub

'mencari total barang dalam grid
Function TotalBarang()
ADO.Recordset.MoveFirst
TTL = 0
Do While Not ADO.Recordset.EOF And ADO.Recordset!Diterima <> 0
    TTL = TTL + ADO.Recordset!Diterima
    ADO.Recordset.MoveNext
    LblTotal = Format(TTL, "#,###")
Loop
End Function


Private Sub CmdSimpan_Click()
If Combo1 = "" Or TxtNomorBon = "" Or LblTotal = "" Then
    MsgBox "data belum lengkap"
    If Combo1 = "" Then
        Combo1.SetFocus
    ElseIf TxtNomorBon = "" Then
        TxtNomorBon.SetFocus
    End If
    Exit Sub
End If

Call Koneksi
Dim simpan1 As String
'simpan transaksi dalam grid ke tabel penerimaan (hanya satu record)
simpan1 = "insert into Penerimaan(nomorTrm,tanggalTrm,kodespl,nomorbon,totaltrm,kodepmk) values " & _
"('" & NomorTrm & "','" & TanggalTrm & "','" & Combo1 & "','" & TxtNomorBon & "','" & LblTotal & "','" & Menu.STBar.Panels(1).Text & "')"
Conn.Execute simpan1

'simpan transaksi dalam grid ke tabel detailterima (beberapa record / berulang)
ADO.Recordset.MoveFirst
Do While Not ADO.Recordset.EOF And ADO.Recordset!Kode <> vbNullString
    Dim simpan2 As String
    simpan2 = "insert into DETAILterima(nomorTrm,KODEBRG,QTYTrm) values " & _
    "('" & NomorTrm & "','" & ADO.Recordset!Kode & "','" & ADO.Recordset!Diterima & "')"
    Conn.Execute simpan2
ADO.Recordset.MoveNext
Loop

'tambah data stok barang yang kodenya diketik dalam grid
ADO.Recordset.MoveFirst
Do While Not ADO.Recordset.EOF
    If ADO.Recordset!Kode <> vbNullString Then
        Call Koneksi
        RSBarang.Open "Select * from Barang where Kodebrg='" & ADO.Recordset!Kode & "'", Conn
        If Not RSBarang.EOF Then
            'tambah barang jika kodenya ditemukan
            Dim TambahBarang1 As String
            TambahBarang1 = "update barang set jumlahbrg='" & RSBarang!jumlahbrg + ADO.Recordset!Diterima & "' where kodebrg='" & ADO.Recordset!Kode & "'"
            Conn.Execute (TambahBarang1)
        End If
    End If
ADO.Recordset.MoveNext
Loop
   
Form_Activate
Call Kosongkan
Call TabelKosong
Combo1.SetFocus
End Sub

Sub Kosongkan()
Combo1 = ""
NamaSpl = ""
PersonSpl = ""
TxtNomorBon = ""
LblTotal = ""
End Sub

'cetak laporan penerimaan
Sub CetakPenerimaan()
    CR.ReportFileName = App.Path & "\Penerimaan.rpt"
    CR.WindowState = crptMaximized
    CR.RetrieveDataFiles
    CR.Action = 1
End Sub

'hapus isi transaksi dalam grid sebelum digunakan
Function TabelKosong()
If ADO.Recordset.RecordCount <> 0 Then
    ADO.Recordset.MoveFirst
    Do While Not ADO.Recordset.EOF
        ADO.Recordset.Delete
        ADO.Recordset.MoveNext
    Loop
    For i = 1 To 10
        ADO.Recordset.AddNew
        ADO.Recordset!Nomor = i
        ADO.Recordset.Update
    Next i
    ADO.Recordset.MoveFirst
    DG.Col = 1
End If
End Function

'nomor BON dari supplier
Private Sub TxtNomorBon_KeyPress(Keyascii As Integer)
If Keyascii = 13 Then
    If TxtNomorBon = "" Then
        TxtNomorBon = "Kosong"
        DG.SetFocus
        DG.Col = 1
    End If
End If
End Sub
 





Private Sub Form_Activate()
Call Koneksi
ADO.ConnectionString = PathData
ADO.RecordSource = "TMPMintaUser"
ADO.Refresh
Set DG.DataSource = ADO
DG.Refresh
Call AutoMnt
TanggalMnt = Date
Call TabelKosong
ADO.Recordset.MoveFirst
CmdSimpan.Enabled = False
End Sub


Private Sub Form_Load()
Call Koneksi
'tampilkan kode dan nama customer dalam combo
RSCustomer.Open "Customer", Conn
Combo1.Clear
Do While Not RSCustomer.EOF
    Combo1.AddItem RSCustomer!KodeCus & Space(7) & RSCustomer!NamaCus
    RSCustomer.MoveNext
Loop
Call KondisiAwal
End Sub

'.menampilkan nomor permintaan secara otomatis
'berdasarkan tanggal

Private Sub AutoMnt()
Call Koneksi
RSPermintaanUser.Open "select * from PermintaanUser Where NomorMnt In(Select Max(NomorMnt)From PermintaanUser)Order By NomorMnt Desc", Conn
RSPermintaanUser.Requery
Dim Urutan As String * 10
Dim Hitung As Long
With RSPermintaanUser
    If .EOF Then
        Urutan = "MT" + Format(Date, "yymmdd") + "01"
        NomorMnt = Urutan
    Else
        If Mid(!NomorMnt, 3, 6) <> Format(Date, "yymmdd") Then
            Urutan = "MT" + Format(Date, "yymmdd") + "01"
        Else
            Hitung = Right(!NomorMnt, 2) + 1
            Urutan = "MT" + Format(Date, "yymmdd") + Right("00" & Hitung, 2)
        End If
    End If
    NomorMnt = Urutan
End With
End Sub

'mencari identitas customor berdasarkan
'3 digit pertama dalam combo
Private Sub COMBO1_Click()
Call Koneksi
RSCustomer.Open "select * from Customer where kodeCus='" & Left(Combo1, 3) & "'", Conn
If Not RSCustomer.EOF Then
    NamaCus = RSCustomer!NamaCus
    PersonCus = RSCustomer!PersonCus
Else
    MsgBox "Kode Customer tidak terdaftar"
    Combo1.SetFocus
End If

End Sub

'mencari identitas customer dapat juga diketik dalam combo
Private Sub COMBO1_KeyPress(Keyascii As Integer)
Keyascii = Asc(UCase(Chr(Keyascii)))
If Keyascii = 13 Then
    If Combo1 = "" Then
        MsgBox "Kode Customer wajib diisi"
        Combo1.SetFocus
        Exit Sub
    ElseIf Combo1 <> "" Then
        Call Koneksi
        RSCustomer.Open "select * from Customer where kodeCus='" & Left(Combo1, 3) & "'", Conn
        If Not RSCustomer.EOF Then
            COMBO1_Click
            NomorReffUser.Enabled = True
            NomorReffUser.SetFocus
        Else
            MsgBox "Kode Customer tidak terdaftar"
            NamaCus = ""
            PersonCus = ""
            Combo1.SetFocus
            Combo1 = ""
            Exit Sub
        End If
    End If
End If

End Sub

'grid hanya dapat diisi angka
Private Sub dg_Keypress(Keyascii As Integer)
If DG.Col = 1 Then
    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack Or Keyascii = vbKeyReturn) Then Keyascii = 0
ElseIf DG.Col = 4 Then
    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack Or Keyascii = vbKeyReturn) Then Keyascii = 0
End If
End Sub

Private Sub CmdBatal_Click()
Combo1 = ""
NamaCus = ""
PersonCus = ""
NomorReffUser = ""
TotalMnt = ""
TotalKrm = ""
LblStok = ""
LblKet = ""
Call TabelKosong
End Sub

Private Sub CmdTutup_Click()
Unload Me
End Sub

'transaksi dalam grid
Private Sub DG_AfterColEdit(ByVal ColIndex As Integer)
    If DG.Col = 1 Then
        If Len(ADO.Recordset!Kode) < 3 Then
            MsgBox "Kode Harus 3 digit" & Chr(13) & _
            "contoh 001,002 dan seterusnya"
            DG.Col = 1
            Exit Sub
        End If
   
        Call Koneksi
        RSBarang.Open "Select * from Barang where KodeBrg='" & ADO.Recordset!Kode & "'", Conn
        'cari data barang yang kodenya di ketik dalam grid
        If Not RSBarang.EOF Then
            ADO.Recordset!Kode = RSBarang!kodebrg
            ADO.Recordset!Nama = RSBarang!namabrg
            ADO.Recordset!stok = RSBarang!jumlahbrg
            DG.Col = 4
            DG.Refresh
            Exit Sub
        End If
    End If
   
    'indikasi terpenhi atau tidaknya permintaan
    If DG.Col = 4 Then
        ADO.Recordset!qtymnt = ADO.Recordset!qtymnt
       
        If ADO.Recordset!qtymnt > ADO.Recordset!stok Then
            ADO.Recordset!dikirim = ADO.Recordset!stok
            ADO.Recordset!ket = "Stok Kurang" & Space(2) & ADO.Recordset!qtymnt - ADO.Recordset!stok
       
        ElseIf ADO.Recordset!qtymnt = ADO.Recordset!stok Then
            ADO.Recordset!dikirim = ADO.Recordset!qtymnt
            ADO.Recordset!ket = "Terpenuhi"
       
        ElseIf ADO.Recordset!qtymnt < ADO.Recordset!stok Then
            ADO.Recordset!dikirim = ADO.Recordset!qtymnt
            ADO.Recordset!ket = "Terpenuhi"
        
        End If
       
        ADO.Recordset.Update
        ADO.Recordset.MoveNext
        DG.Col = 1
        DG.Refresh
        Call CariTotalMnt
        If TotalMnt <> "" Then
            CmdSimpan.Enabled = True
            CmdBatal.Enabled = True
            CmdTutup.Enabled = True
        End If
        Call CariTotalKrm
    End If
End Sub

'menampilkan indikasi ketersediaan barang
'secara keseluruhan
Sub Keterangan()
Call Koneksi
Dim ket As New ADODB.Recordset
ket.Open "select count(ket) as ketemu from TMPMintaUser where ket like '%Stok Kurang%'", Conn
ket.Requery

If ket!ketemu > 0 Then
    LblKet = "Stok Kurang"
Else
    LblKet = "Terpenuhi"
End If

End Sub

'mencari jumlah total dalam grid
Function CariTotalKrm()
ADO.Recordset.MoveFirst
TTL = 0
Do While Not ADO.Recordset.EOF And ADO.Recordset!dikirim <> vbNullString
    TTL = TTL + ADO.Recordset!dikirim
    ADO.Recordset.MoveNext
    If TTL = 0 Then
        TotalKrm = 0
    Else
        TotalKrm = Format(TTL, "#,###")
    End If
Loop
End Function

Function CariTotalMnt()
ADO.Recordset.MoveFirst
TTL = 0
Do While Not ADO.Recordset.EOF And ADO.Recordset!qtymnt <> vbNullString
    TTL = TTL + ADO.Recordset!qtymnt
    ADO.Recordset.MoveNext
    TotalMnt = Format(TTL, "#,###")
Loop
End Function


Private Sub CmdSimpan_Click()
Call Keterangan

    If Combo1 = "" Or NomorReffUser = "" Then
        MsgBox "data belum lengkap"
        Exit Sub
    End If

Pesan = MsgBox("Data sudah benar..?", vbYesNo)
If Pesan = vbYes Then

    Call Koneksi
   
    'simpan ke tabel PermintaanUser
    Dim Simpan As String
    Simpan = "insert into PermintaanUser(nomorMnt,tanggalMnt,kodecus,nomorreffuser,totalMnt,TotalKrm,kodepmk,ket,KetKirim) values " & _
    "('" & NomorMnt & "','" & TanggalMnt & "','" & Left(Combo1, 3) & "','" & NomorReffUser & "','" & TotalMnt & "','" & TotalKrm & "','" & Menu.STBar.Panels(1).Text & "','" & LblKet & "','Belum Dikirim')"
    Conn.Execute Simpan
       
    'simpan ke tabel DetailMintaUser
    ADO.Recordset.MoveFirst
    Do While Not ADO.Recordset.EOF And ADO.Recordset!Kode <> vbNullString
        Dim simpan2 As String
        simpan2 = "insert into DetailMintaUser(nomorMnt,KODEBRG,stok,QTYMnt,dikirim,ket) values " & _
        "('" & NomorMnt & "','" & ADO.Recordset!Kode & "','" & ADO.Recordset!stok & "','" & ADO.Recordset!qtymnt & "','" & ADO.Recordset!dikirim & "','" & ADO.Recordset!ket & "')"
        Conn.Execute simpan2
    ADO.Recordset.MoveNext
    Loop
    Form_Activate
    Call Kosongkan
    Call TabelKosong

End If
End Sub

Sub Kosongkan()
Call KosongkanCus
TotalMnt = ""
TotalKrm = ""
LblKet = ""
End Sub

Sub CetakPermintaanUser()
    CR.ReportFileName = App.Path & "\PermintaanUser.rpt"
    CR.WindowState = crptMaximized
    CR.RetrieveDataFiles
    CR.Action = 1
End Sub

'kosongkan tabel temporer sebelum digunakan dalam transaksi
Function TabelKosong()
On Error Resume Next
If ADO.Recordset.RecordCount <> 0 Then
    ADO.Recordset.MoveFirst
    Do While Not ADO.Recordset.EOF
        ADO.Recordset.Delete
        ADO.Recordset.MoveNext
    Loop
    For i = 1 To 10
        ADO.Recordset.AddNew
        ADO.Recordset!nomor = i
        ADO.Recordset.Update
    Next i
    ADO.Recordset.MoveFirst
    DG.Col = 1
End If
End Function

Private Sub NomorReffUser_KeyPress(Keyascii As Integer)
If Keyascii = 13 Then
    If NomorReffUser = "" Then
        NomorReffUser = "Kosong"
        DG.SetFocus
        DG.Col = 1
    Else
        DG.SetFocus
        DG.Col = 1
    End If
End If

End Sub

Sub BukaCus()
Combo1.Enabled = True
NamaCus.Enabled = False
PersonCus.Enabled = False
NomorReffUser.Enabled = True
End Sub

Sub TutupCus()
Combo1.Enabled = False
NamaCus.Enabled = False
PersonCus.Enabled = False
NomorReffUser.Enabled = False
End Sub

Sub KondisiAwal()
Call TutupCus
Call KosongkanCus
Call Kosongkan
Combo1.Enabled = True
End Sub

Sub KosongkanCus()
Combo1 = ""
NamaCus = ""
PersonCus = ""
NomorReffUser = ""
End Sub


Private Sub CmdBantuan_Click()
If CmdBantuan.Caption = "Lihat &Kode Barang" Then
    Me.Width = 12800
    Call Tengah
    CmdBantuan.Caption = "Tutup &Kode Barang"
    Call Koneksi
    RSBarang.Open "select * from barang order by namabrg", Conn
    List1.Clear
    Do While Not RSBarang.EOF
        List1.AddItem RSBarang!kodebrg & vbTab & RSBarang!jumlahbrg & vbTab & RSBarang!namabrg
        RSBarang.MoveNext
    Loop
Else
    Me.Width = 9800
    Call Tengah
    CmdBantuan.Caption = "Lihat &Kode Barang"
End If
End Sub

Public Sub Tengah()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
End Sub
 






Private Sub Form_Activate()
Call Koneksi
ADO.ConnectionString = PathData
ADO.RecordSource = "TMPKeluarUser"
ADO.Refresh
Set DG.DataSource = ADO
DG.Refresh
TanggalKlr = Date
'tampilkan data permintaan user yang belum dikirim
RSPermintaanUser.Open "select * from permintaanuser where ketkirim='Belum Dikirim'", Conn
Combo1.Clear
Do While Not RSPermintaanUser.EOF
    Combo1.AddItem RSPermintaanUser!NomorMnt
    RSPermintaanUser.MoveNext
Loop
Call TabelKosong
End Sub

Private Sub Form_Load()
Call KondisiAwal
Call TabelKosong
End Sub

Sub TabelKosong()
Call Koneksi
Dim hapus As String
hapus = "delete * from TMPKELUARuSER"
Conn.Execute hapus
End Sub

Private Sub CmdSimpan_Click()
If Combo1 = "" Then
    MsgBox "Pilih nomor permintaan di combo1"
    Combo1.SetFocus
    Exit Sub
Else
    Call Koneksi
    RSPermintaanUser.Open "select * from permintaanuser where nomormnt='" & Combo1 & "'", Conn
    If Not RSPermintaanUser.EOF Then
        Dim edit As String
        'edit data permintaan bahwa nomor ini SUDAH DIKIRIM
        edit = "update permintaanuser set ketkirim='Sudah Dikirim' where nomormnt='" & Combo1 & "'"
        Conn.Execute edit

       
        Dim Simpan As String
        'simpan ke tabel pengeluaran
        Simpan = "insert into pengeluaran(nomorklr,tanggalklr,kodecus,nomorbon,totalmnt,TotalKrm,kodepmk,ket,KetKirim) values " & _
        "('" & NomorKlr & "','" & TanggalKlr & "','" & KodeCus & "','" & NomorReffUser & "','" & TotalMnt & "','" & TotalKrm & "','" & Menu.STBar.Panels(1).Text & "','" & LblKet & "','Sudah Dikirim')"
        Conn.Execute Simpan

        'simpan ke tabel detailkeluar
        ADO.Recordset.MoveFirst
        Do While Not ADO.Recordset.EOF
            Dim simpan2 As String
            simpan2 = "insert into Detailkeluar(nomorklr,KODEBRG,stok,QTYMnt,dikirim,ket) values " & _
            "('" & NomorKlr & "','" & ADO.Recordset!Kode & "','" & ADO.Recordset!stok & "','" & ADO.Recordset!qtymnt & "','" & ADO.Recordset!dikirim & "','" & ADO.Recordset!ket & "')"
            Conn.Execute simpan2
        ADO.Recordset.MoveNext
        Loop
       
        'kurangi jumlah barang
        ADO.Recordset.MoveFirst
        Do While Not ADO.Recordset.EOF
            If ADO.Recordset!Kode <> vbNullString Then
                Call Koneksi
                RSBarang.Open "Select * from Barang where Kodebrg='" & ADO.Recordset!Kode & "'", Conn
                If Not RSBarang.EOF Then
                    Dim KurangiStokBarang As String
                    KurangiStokBarang = "update barang set jumlahbrg='" & RSBarang!jumlahbrg - ADO.Recordset!dikirim & "' where kodebrg='" & ADO.Recordset!Kode & "'"
                    Conn.Execute (KurangiStokBarang)
                End If
            End If
        ADO.Recordset.MoveNext
        Loop
       
        Form_Activate
        Call KondisiAwal
        'Call CetakPengeluaranBarang
    End If
End If
End Sub

Sub CetakPengeluaranBarang()
    CR.ReportFileName = App.Path & "\master pengeluaran.rpt"
    CR.WindowState = crptMaximized
    CR.RetrieveDataFiles
    CR.Action = 1
End Sub

'nomor pengeluaran akan secara otomatis
'diambil dari nomor permintaan
'hanya dibedakan 2 huruf depannya saja
Private Sub COMBO1_Click()
NomorKlr = "KL" + Right(Combo1, 8)
Call Koneksi
Dim RSCari As New ADODB.Recordset
'mencari dan menampilkan data permintaan
RSCari.Open "select * from permintaanuser where nomormnt='" & Combo1 & "'", Conn
If Not RSCari.EOF Then
    TanggalMnt = RSCari!TanggalMnt
    NomorReffUser = RSCari!NomorReffUser
    TotalMnt = RSCari!TotalMnt
    TotalKrm = RSCari!TotalKrm
    LblKet = RSCari!ket
    'mencari dan menampilkan data customer
    RSCustomer.Open "select * from customer where kodecus='" & RSCari!KodeCus & "'", Conn
    If Not RSCustomer.EOF Then
        KodeCus = RSCari!KodeCus
        NamaCus = RSCustomer!NamaCus
        PersonCus = RSCustomer!PersonCus
    End If
End If
'jika data ditemukan, tampilkan datanya dalam grid
ADO.ConnectionString = PathData
ADO.RecordSource = "SELECT BARANG.KODEBRG AS KODE,NAMABRG AS NAMA,STOK,QTYMNT,DIKIRIM,KET FROM BARANG,DETAILMINTAUSER WHERE BARANG.KODEBRG=DETAILMINTAUSER.KODEBRG AND NOMORMNT='" & Combo1 & "'"
ADO.Refresh
Set DG.DataSource = ADO
DG.Refresh
End Sub

Private Sub CmdBatal_Click()
Call KondisiAwal
Form_Activate
Combo1.SetFocus
End Sub

Private Sub CmdTutup_Click()
Unload Me
End Sub

Sub TutupCus()
KodeCus.Enabled = False
NamaCus.Enabled = False
PersonCus.Enabled = False
NomorReffUser.Enabled = False
End Sub


Sub KondisiAwal()
TanggalKlr = Date
Call TutupCus
Call KosongkanCus
TanggalMnt = ""
TanggalKlr = ""
NomorReffUser = ""
TotalMnt = ""
TotalKrm = ""
LblKet = ""
NomorKlr = ""
Combo1 = ""
End Sub

Sub KosongkanCus()
KodeCus = ""
NamaCus = ""
PersonCus = ""
End Sub

Artikel Terkait

uus rusmawan

Next Post
Previous Post

1 comments so far

avatar
Balas
Dian Astri Saputra delete December 13, 2020 at 3:28 PM
This comment has been removed by the author.


EmoticonEmoticon

Subscribe to: Post Comments (Atom)