Form Retur Pembelian


                Setiap toko yang melakukan pembelian barang tidak pasti semua barang yang dipesan keadaannya semuanya sempurna. Oleh karena itu barang-barang tersebut harus dikembalikan kepada pihak supplier barang tersebut. Oleh karena itu aplikasi ini akan mencover hal ini dan kita akan membuat form retur pembelian barang. Form retur pembelian ini bertujuan untuk mencatat retur barang yang terjadi. Untuk membuat from retur pembelian ini yang kita butuhkan adalah :

Object
Properties
Setting
Form
Name
FrmBeliBarang

BorderStyle
0-None

BackColor
&H00FFC0C0&

StartUpPosition
2-CenterScreen
Label
Name
Label1

Font
Calibri

ForeColor
&H8000000D&

Caption
Form Retur Pembelian

Name
Label2

Font
Calibri

ForeColor
&H8000000D&

Caption
No Kwitansi

Name
Label3

Font
Calibri

ForeColor
&H8000000D&

Caption
Supplier

Name
Label4

Font
Calibri

ForeColor
&H8000000D&

Caption
Tanggal Transaksi

Name
Label5

Font
Calibri

ForeColor
&H8000000D&

Caption
Tanggal Kirim

Name
Label6

Font
Calibri

ForeColor
&H8000000D&

Caption
Penerima

Name
Label7

Font
Calibri

ForeColor
&H8000000D&

Caption
Nama Barang

Name
Label8

Font
Calibri

ForeColor
&H8000000D&

Caption
Alasan

Name
Label9

Font
Calibri

ForeColor
&H8000000D&

Caption
Jumlah Barang Retur
Textbox
Name
TxtSupplier

Appearance
0-Flat

Height
330

Name
TxtPenerima

Appearance
0-Flat

Height
330

Name
TxtAlasan

Appearance
0-Flat

Height
330
TDBDate
Name
TxtTgl

DisplyFormat
dd mmmm yyy

ButtonVisible
1-True

Height
330

Name
TxtTglKirim

DisplyFormat
dd mmmm yyy

ButtonVisible
1-True

Height
330
SSOleDBCombo
Name
CmbBarang

Height
330

BackColorOdd
&H00FFC0C0&

Name
CmbBarang

Height
330

BackColorOdd
&H00FFC0C0&

Name
CmbTransaksi

Height
330

BackColorOdd
&H00FFC0C0&

Name
CmbBarang

Height
330

BackColorOdd
&H00FFC0C0&
TDBNumber
Name
TxtJumlah

Height
330

appearance
0-Flat

DisplayFormat
###,###,###,##0.00;(###,###,###,##0.00)

Format
###,###,###,##0.00
VBButton
Name
CmdSave

ButtonType
4-Mac

Caption
&Save

Name
CmdCancel

ButtonType
4-Mac

Caption
&Cancel

Name
CmdInput

ButtonType
4-Mac

Caption
&Cari

Name
vbButton1

ButtonType
3-WindowsXP

Caption
-

BackColor
&H00FFC0C0&

Name
vbButton2

ButtonType
3-WindowsXP

Caption
X

BackColor
&H00FFC0C0&
TDBGrid
Name
Grid

DeadAreaColor
&H00FFC0C0&

ColumnFooter
False

MarqueeStyle
2-HighlightCell
Adodc
Name
AdoBarang

Visible
False

Name
AdoTransaksi

Visible
False

Tampilan design form retur pembelian :



Tampilan form retur pembelian saat dijalankan :


Source code program form retur pembelian :
Dim RsTemp3 As New ADODB.Recordset
Dim Keterangan1 As Integer

Private Sub CmbBarang_DropDown()
AdoBarang.RecordSource = ""
SQL = "SELECT     DtlBeliBarang.KodeBarang, Barang.NamaBarang, DtlBeliBarang.Jumlah, " & _
    " Barang.NamaBarang + ' - ' + DtlBeliBarang.Jumlah + ' ' + Barang.Satuan AS Pesanan " & _
    " FROM         Barang INNER JOIN " & _
    " DtlBeliBarang ON Barang.KodeBarang = DtlBeliBarang.KodeBarang where " & _
    " kodeTransaksi='" & Trim(CmbTransaksi) & "'"
Set RSFind = DbCon.Execute(SQL)
If RSFind.BOF Then Exit Sub
AdoBarang.RecordSource = SQL
AdoBarang.Refresh
With CmbBarang
    .DataSourceList = AdoBarang
    .DataFieldList = "Pesanan"
    .Columns(0).Visible = False
    .Columns(1).Visible = False
    .Columns(2).Visible = False
    .Columns(3).Width = 4000
End With
End Sub


Private Sub CmbBarang_GotFocus()
If Trim(CmbTransaksi) = "" Or Not CmbTransaksi.IsItemInList Then
    MsgBox "Transaksi Belum Dipilih"
    CmbTransaksi.SetFocus
    Exit Sub

End If
End Sub

Private Sub CmbTransaksi_Click()
TxtSupplier = Trim(CmbTransaksi.Columns(2).Text)
TxtTgl = CmbTransaksi.Columns(1).Value
TxtTglKirim = CmbTransaksi.Columns(3).Value
CmbBarang = ""
CmbBarang.SetFocus
End Sub

Private Sub CmbTransaksi_DropDown()
AdoTransaksi.RecordSource = ""
SQL = "SELECT * from BeliBarang"
Set RSFind = DbCon.Execute(SQL)
If RSFind.BOF Then Exit Sub
AdoTransaksi.RecordSource = SQL
AdoTransaksi.Refresh
With CmbTransaksi
    .DataSourceList = AdoTransaksi
    .DataFieldList = "KodeTransaksi"
    .Columns(3).Visible = False
    .Columns(2).Visible = False
    .Columns(1).Visible = False
    .Columns(3).Width = 4000
End With
End Sub

Private Sub CmdCancel_Click()
Form_Load
End Sub

Private Sub CmdInput_Click()
If Trim(CmbBarang) = "" Or Not CmbBarang.IsItemInList Then
    MsgBox "Barang Belum Ada"
    CmbBarang.SetFocus
    Exit Sub
ElseIf Trim(TxtAlasan) = "" Then
    MsgBox "Alasan Belum Ada"
    TxtAlasan.SetFocus
    Exit Sub
ElseIf TxtJumlah = 0 Then
    MsgBox "Jumlah Belum Ada"
    TxtJumlah.SetFocus
    Exit Sub
End If

SQL = "Select jumlah from dtlbelibarang where kodeTransaksi='" & Trim(CmbTransaksi) & _
    "' and kodebarang='" & Trim(CmbBarang.Columns(0).Text) & "'"
Set RSFind = DbCon.Execute(SQL)
If Val(RSFind!Jumlah) < TxtJumlah Then
    MsgBox "Jumlah Tidak Sesuai Dengan Pesanan"
    TxtJumlah = 0
    TxtJumlah.SetFocus
    Exit Sub
End If

RsTemp3.Find "KodeBarang='" & Trim(CmbBarang.Columns(0).Text) & "'", , adSearchForward, 1

If RsTemp3.EOF Then
    With RsTemp3
        .AddNew
        !NoKet = .RecordCount
        !KodeBarang = Trim(CmbBarang.Columns(0).Text)
        !namaBarang = Trim(CmbBarang.Columns(1).Text)
        !Jumlah = TxtJumlah
        !Alasan = Trim(TxtAlasan)
        .Update
        Grid.Refresh
        CmbBarang = ""
        TxtAlasan = ""
        TxtJumlah = 0
        CmbBarang.SetFocus
    End With
Else
    MsgBox "Barang Sudah Dinputkan"
    CmbBarang = ""
    TxtAlasan = ""
    TxtJumlah = 0
    CmbBarang.SetFocus
    Exit Sub
End If
End Sub

Private Sub CmdSave_Click()
If RsTemp3.RecordCount = 0 Then
    MsgBox "Tidak Ada Daftar Barang Retur"
    Exit Sub
Else
    SQL = "insert into ReturBeli values('" & Trim(CmbTransaksi) & "','" & FormatTgl(Date) & "','" & _
        Trim(TxtPenerima) & "')"
    DbCon.Execute SQL
   
    RsTemp3.MoveFirst
    While Not RsTemp3.EOF
        With RsTemp3
            SQL = "insert into dtlReturBeli values('" & Trim(CmbTransaksi) & "','" & FormatTgl(Date) & "','" & _
            Trim(!NoKet) & "','" & Trim(!KodeBarang) & "','" & !Jumlah & "','" & !Alasan & "')"
            DbCon.Execute SQL
        End With
        RsTemp3.MoveNext
    Wend
End If

MsgBox "Data Saved"
Form_Load
End Sub

Private Sub Form_Load()
AdoTransaksi.ConnectionString = ConDB
AdoBarang.ConnectionString = ConDB
Bersih

With RsTemp3
    If .State Then .Close
    .Fields.Append "NoKet", adInteger, 4
    .Fields.Append "KodeBarang", adVarChar, 50
    .Fields.Append "NamaBarang", adVarChar, 50
    .Fields.Append "Jumlah", adInteger, 4
    .Fields.Append "Alasan", adVarChar, 100
    .Open
    Set Grid.DataSource = RsTemp3
    Grid.Refresh
End With
End Sub

Sub Bersih()
CmbTransaksi = ""
TxtSupplier = ""
TxtTgl = Null
TxtTglKirim = Null
CmbBarang = ""
TxtAlasan = ""
TxtPenerima = ""
End Sub


Private Sub Grid_Click()
Keterangan1 = Val(Grid.Columns(0).Text)
End Sub

Private Sub Grid_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then
    If Keterangan1 = 0 Then
    MsgBox "Klik Salah Satu Item Di Tabel"
    Exit Sub
End If
RsTemp3.Find "noket='" & Keterangan1 & "'", , adSearchForward, 1
If Not RsTemp3.EOF Then
    MsgBox RsTemp3!NoKet & " Dibatalkan"
    RsTemp3.Delete
End If
    Keterangan1 = Keterangan1 + 1
    RsTemp3.Find "noket='" & Keterangan1 & "'", , adSearchForward, 1
    While Not RsTemp3.EOF
        With RsTemp3
            .Clone
            !NoKet = !NoKet - 1
            .Update
        End With
        RsTemp3.MoveNext
    Wend
Grid.Refresh
End If
End Sub

Private Sub Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Keterangan1 = Val(Grid.Columns(0).Text)
End Sub

Private Sub vbButton1_Click()
Me.WindowState = vbMinimized
End Sub

Private Sub vbButton2_Click()
Unload Me
End Sub

Comments

Popular posts from this blog

Flowchart Penjualan Grosir / Eceran

Flowchart Proses Pembelian Barang