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
Post a Comment