Demo image Demo image Demo image Demo image Demo image Demo image

Form Transaksi Penjualan

  • Rabu, 04 April 2012
  • && Form Transaksi Penjualan Metode Adodb &&
    && Modul &&
    Public koneksi As New ADODB.Connection
    Public rsoperator As New ADODB.Recordset
    Public rstransaksi As New ADODB.Recordset
    Public rsdetail As New ADODB.Recordset
    Public rsbarang As New ADODB.Recordset

    Sub buka_koneksi()
        koneksi.CursorLocation = adUseClient
        koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        App.Path & "\Access\data.mdb"
    End Sub

    Function nilaiangka(nteks As String)
        nilaiangka = Format(nteks, "##0")
    End Function

    && Koding &&
    Dim lvbarang As ListItem
    Dim lvopr As ListItem
    Dim sqlbarang As New ADODB.Recordset


    Private Sub Form_Activate()
        Me.txtkodeoperator.SetFocus
    End Sub

    Private Sub Form_Load()
        buka_koneksi
       
        If rstransaksi.State = 0 Then rstransaksi.Open "select*from transaksi", koneksi, adOpenKeyset, adLockOptimistic
        rsdetail.Open "select*from detail", koneksi, adOpenKeyset, adLockOptimistic
        rsbarang.Open "select*from hardware", koneksi, adOpenKeyset, adLockOptimistic
       
        Me.txttgl.Text = Format(Date, "dd-mmm-yyyy")
        no_nota
    End Sub

    Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
        Select Case KeyCode
            Case vbKeyF10
                Image2_Click
            Case vbKeyEscape
                teksbarangkosong
                Me.txtpembayaran.SetFocus
        End Select
    End Sub

    Sub no_nota()
        Dim tgl As String
        Dim bln As String
        Dim thn As String
       
        tgl = Day(Date)
        If tgl < 10 Then
            tgl = "0" + tgl
        End If
        bln = Month(Date)
        If bln < 10 Then bln = "0" + bln
        thn = Year(Date)
       
        With rstransaksi
            If .RecordCount > 0 Then .MoveLast
            If .RecordCount = 0 Then
                Me.txtnota.Text = "T" + tgl + bln + thn + "000001"
            Else
                Me.txtnota.Text = "T" + tgl + bln + thn + Right("000000" + Trim(Str(Val(Right(.Fields(0), 6)) + 1)), 6)
            End If
        End With
    End Sub

    Private Sub Image1_Click()                ‘menampilkan list operator
        isilistoperator
        Me.ListOperator.Height = 1785
        Me.ListOperator.Visible = True
        Me.ListOperator.SetFocus
    End Sub

    Sub isilistoperator()
        If rsoperator.State = adStateClosed Then
            rsoperator.Open "select*From Operator", koneksi, adOpenKeyset, adLockOptimistic
        End If
       
        With rsoperator
            Me.ListOperator.ListItems.Clear
            .MoveFirst
            While Not .EOF
                Set lvopr = Me.ListOperator.ListItems.Add(, , .Fields(0))
                lvopr.SubItems(1) = .Fields(1)
                .MoveNext
            Wend
            End With
    End Sub

    Private Sub ListOperator_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            Me.txtkodeoperator.Text = Me.ListOperator.SelectedItem.Text
            Me.txtnamaoperator.Text = Me.ListOperator.ListItems(Me.ListOperator.SelectedItem.Index).SubItems(1)
            Me.ListOperator.Visible = False
            Me.txtkodebarang.SetFocus
        End If
    End Sub

    Private Sub Image2_Click()                ‘menampilkan grid barang
        isigridbarang
        Me.gridbarang.Visible = True
        Me.gridbarang.SetFocus
        SendKeys "{Right}"
    End Sub

    Sub isigridbarang()
        If sqlbarang.State = 0 Then sqlbarang.Open "select kdhard,nmhard,hargajual,stok from hardware where stok>0", koneksi, adOpenKeyset, adLockReadOnly
        Set Me.gridbarang.DataSource = sqlbarang
    End Sub

    ‘ingat supaya bisa setfocus ke txtjumlah : grid barang klik kananà property à splits à locked
    Private Sub gridbarang_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            Me.txtkodebarang.Text = Me.gridbarang.Columns(0).Text
            Me.txtnamabarang.Text = Me.gridbarang.Columns(1).Text
            Me.txtharga.Text = Me.gridbarang.Columns(2).Text
            Me.gridbarang.Visible = False
            Me.txtjml.SetFocus
        End If
    End Sub

    Private Sub txtjml_Change()
        Me.txtsubtotal.Text = 0
        Me.txtsubtotal.Text = Val(Me.txtharga.Text) * Val(Me.txtjml.Text)
    End Sub

    Private Sub txtjml_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Me.txtjml.Text = "" Then
            MsgBox "Masukkan Jumlah Barang....", vbInformation + vbOKOnly, "Informasi"
        Else
            'memasukkan data barang ke listbarang
            Set lvbarang = Me.listbarang.ListItems.Add(, , Me.txtkodebarang.Text)
                lvbarang.SubItems(1) = Me.txtnamabarang.Text
                lvbarang.SubItems(2) = Me.txtharga.Text
                lvbarang.SubItems(3) = Me.txtjml.Text
                lvbarang.SubItems(4) = Me.txtsubtotal.Text
           
            'kosongkan teks barang
            teksbarangkosong
            Me.txtkodebarang.SetFocus
           
            'hitung total
            Me.txtgrandtotal.Text = Format(hitungtotal, "#,#0")
        End If
    End If
    End Sub

    Function hitungtotal()
        Dim SubTotal As Long
        SubTotal = 0
       
        For i = 1 To Me.listbarang.ListItems.Count
            Set lvbarang = Me.listbarang.ListItems(i)
            SubTotal = SubTotal + Val(Me.listbarang.ListItems(i).SubItems(4))
        Next i
        hitungtotal = SubTotal
    End Function

    Sub teksbarangkosong()
        Me.txtkodebarang.Text = ""
        Me.txtnamabarang.Text = ""
        Me.txtharga.Text = ""
        Me.txtjml.Text = ""
        Me.txtsubtotal.Text = ""
    End Sub
    Private Sub txtkodeoperator_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then Image1_Click
    End Sub

    Private Sub txtkodebarang_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        With rsbarang
            'pencarian data melalui kode hardware
            If .RecordCount > 0 Then .MoveFirst
            .Find "kdhard='" & Me.txtkodebarang.Text & "'"
            If Not .EOF Then
                'data ditemukan
                Me.txtnamabarang.Text = .Fields(1)
                Me.txtharga.Text = .Fields(4)
                Me.txtjml.SetFocus
            Else
                MsgBox "Data dengan kode :" & Me.txtkodebarang.Text & vbCrLf & "Belum terdaftar....", vbInformation + vbOKOnly, "Informasi"
            End If
        End With
    End If
    End Sub

    Private Sub txtpembayaran_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Val(Me.txtpembayaran.Text) < Val(Me.txtgrandtotal) Then
            MsgBox "Maaf, uang pembayaran kurang...", vbInformation + vbOKOnly, "Informasi"
        Else
            Me.txtkembali.Text = Format(Val(Me.txtpembayaran.Text) - Val(Format(Me.txtgrandtotal.Text, "##0")), "#,#0")
            Me.txtpembayaran.Text = Format(Me.txtpembayaran.Text, "#,#0")
           
            cetaknota
            simpandata
        End If
    End If
    End Sub

    Sub cetaknota()
        Open "C:\nota.txt" For Output As #1
        Print #1, " Nota Penjualan "
        Print #1, " Toko Serbaguna "
        Print #1, " Jl. Serayu Manis No. 20 "
        Print #1, " ================================= "
       
        Print #1, " Nota    : " & Me.txtnota.Text
        Print #1, " Tanggal : " & Me.txttgl.Text
        Print #1, " Kasir   : " & Me.txtnamaoperator.Text
        Print #1, ""
        Print #1, "Kode     | Nama                    |  Harga   | Jml |   Total   |"
        For i = 1 To Me.listbarang.ListItems.Count
            Set lvbarang = Me.listbarang.ListItems(i)
           
            Print #1, lvbarang.Text & Space$(5) & _
            Me.listbarang.ListItems(i).SubItems(1) & Space$(10) & _
            Me.listbarang.ListItems(i).SubItems(2) & Space$(5) & _
            Me.listbarang.ListItems(i).SubItems(3) & Space$(4) & _
            Me.listbarang.ListItems(i).SubItems(4)
        Next
       
        Print #1, "---------------------------------------------------------------------"
        Print #1, "Grand Total : " & Me.txtgrandtotal.Text
        Print #1, "Bayar       : " & Me.txtpembayaran.Text
        Print #1, "Kembalian   : " & Me.txtkembali.Text
       
        Close #1
       
        Open "C:\Cetak1.bat" For Output As #2
        Print #2, "type C:\Nota.txt > prn"
        Print #2, "exit"
       
        Close #2
       
        Shell "C:\Cetak1.bat"
    End Sub

    Sub simpandata()
        'simpan ke tabel transaksi
        With rstransaksi
            .AddNew
                .Fields("Notrans") = Me.txtnota.Text
                .Fields("tgl") = Format(Me.txttgl.Text, "mm/dd/yyyy")
                .Fields("jam") = Time
                .Fields("kdopr") = Me.txtkodeoperator.Text
                .Fields("grandtotal") = Format(Me.txtgrandtotal.Text, "##0")
                .Fields("bayar") = Format(Me.txtpembayaran.Text, "##0")
                .Fields("kembali") = nilaiangka(Me.txtkembali.Text)
            .Update
        End With
       
        'simpan ke tabel detail
        For i = 1 To Me.listbarang.ListItems.Count
            Set lvbarang = Me.listbarang.ListItems(i)
            With rsdetail
                .AddNew
                    .Fields("notrans") = Me.txtnota.Text
                    .Fields("kdhard") = lvbarang.Text
                    .Fields("hrg") = Me.listbarang.ListItems(i).SubItems(2)
                    .Fields("jml") = Me.listbarang.ListItems(i).SubItems(3)
                .Update
             End With
               
                'update stok barang/pengurangan stok barang
                With rsbarang
                    .MoveFirst
                    .Find "kdhard='" & lvbarang & "'"
                    If Not .EOF Then
                        .Fields("stok") = .Fields("stok") - Val(Me.listbarang.ListItems(i).SubItems(3))
                        .Update
                    End If
                End With
            Next
    End Sub

    di 19.20