Form Mutasi Barang
Setiap toko
yang berskala besar pasti memiliki tempat penyimpanan barang yang disebut
dengan nama gudang yang terpisah dari toko tempat berjulan apalagi
barang-barang tersebut berukuran besar. Dan biasanya barang-barang yang baru
dibeli tidak langsung masuk ke dalam toko tetapi ditampung terlebih dahulu di
gudang penyimpanan. Baru setelah barang di toko mulai berkurang maka barang
dari gudang akan dikeluarkan ke toko. Dan pada aplikasi ini akan mencatat
proses keluar masuk barang dari gudang atau dari toko. Di dalam aplikasi ini
saya hanya membatasi dua buah gudang penyimpanan barang dan sebuah toko dan
jika anda akan menambahkannya silahkan saja.
Yang diperlukan untuk membuat
form mutasi barang ini adalah :
Object
|
Properties
|
Setting
|
Form
|
Name
|
frmJenisBarang
|
|
BorderStyle
|
0-None
|
|
BackColor
|
&H00FFC0C0&
|
|
StartUpPosition
|
2-CenterScreen
|
Label
|
Name
|
Label1
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Form Mutasi Barang
|
|
Name
|
Label2
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Tanggal Mutasi
|
|
Name
|
Label3
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Tempat Asal
|
|
Name
|
Label4
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Tempat Tujuan
|
|
Name
|
Label5
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Keterangan
|
|
Name
|
Label6
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Nama Barang
|
|
Name
|
Label7
|
|
Font
|
Calibri
|
|
ForeColor
|
&H8000000D&
|
|
Caption
|
Jumlah
|
Textbox
|
Name
|
TxtKet
|
|
Appearance
|
0-Flat
|
|
Height
|
330
|
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&
|
SSOleDBCombo
|
Name
|
CmbAsal
|
|
BackColorOdd
|
&H00FFC0C0&
|
|
DataMode
|
2-ssDataModeAddItem
|
|
Isian
|
Gudang 1
|
|
|
Gudang 2
|
|
|
Toko
|
|
Name
|
CmbTujuan
|
|
BackColorOdd
|
&H00FFC0C0&
|
|
DataMode
|
2-ssDataModeAddItem
|
|
Isian
|
Gudang 1
|
|
|
Gudang 2
|
|
|
Toko
|
|
Name
|
CmbBarang
|
|
BackColorOdd
|
&H00FFC0C0&
|
|
DataMode
|
2-ssDataModeBound
|
Adodc
|
Name
|
Adodc1
|
TDBGrid
|
Name
|
Grid
|
|
DeadAreaColor
|
&H00FFC0C0&
|
|
ColumnFooter
|
False
|
|
MarqueeStyle
|
2-HighlightCell
|
Tampilan design
form mutasi barang :
Tampilan form
mutasi barang saat dijalankan :
Source Code
program :
Dim
Keterangan1 As Integer
Private Sub
CmbAsal_KeyDown(KeyCode As Integer, Shift As Integer)
Enter KeyCode
End Sub
Private Sub
CmbBarang_DropDown()
Adodc1.RecordSource
= ""
SQL =
"Select KodeBarang,NamaBarang,Satuan from Barang order by kodeBarang"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then Exit Sub
Adodc1.RecordSource
= SQL
Adodc1.Refresh
With CmbBarang
.DataSourceList = Adodc1
.DataFieldList = "NamaBarang"
.Columns(0).Visible = False
.Columns(1).Width = 2000
End With
End Sub
Private Sub
cmbBarang_GotFocus()
If
IsNull(TxtTgl) Or TxtTgl < Date Then
MsgBox "Tanggal Tidak Valid"
TxtTgl.SetFocus
Exit Sub
ElseIf CmbAsal
= CmbTujuan Then
MsgBox "Tempat Asal Jangan Sama Dengan
Tempat Tujuan"
CmbTujuan = ""
CmbTujuan.SetFocus
Exit Sub
ElseIf
Trim(CmbAsal) = "" Or Not CmbAsal.IsItemInList Then
MsgBox "Tempat Asal masih Kosong"
CmbAsal.SetFocus
Exit Sub
ElseIf
Trim(CmbTujuan) = "" Or Not CmbTujuan.IsItemInList Then
MsgBox "Tempat Tujuan Masih Kosong"
CmbTujuan.SetFocus
Exit Sub
ElseIf
Trim(TxtKet) = "" Then
MsgBox "Keterangan Masih Kosong"
TxtKet.SetFocus
Exit Sub
End If
End Sub
Private Sub
CmbTujuan_KeyDown(KeyCode As Integer, Shift As Integer)
Enter KeyCode
End Sub
Private Sub
CmdCancel_Click()
Form_Load
End Sub
Private Sub
CmdInput_Click()
If
Trim(CmbBarang) = "" And Not CmbBarang.IsItemInList Then
MsgBox "Barang Masih Kosong"
CmbBarang.SetFocus
Exit Sub
ElseIf
TxtJumlah = 0 Then
MsgBox "Jumlah masih Kosong"
TxtJumlah.SetFocus
Exit Sub
End If
RsTmp.Find
"namaBarang='" & Trim(CmbBarang) & "'", ,
adSearchForward, 1
If RsTmp.EOF
Then
With RsTmp
.AddNew
!noket = RsTmp.RecordCount
!namaBarang = Trim(CmbBarang)
!KodeBarang =
Trim(CmbBarang.Columns(0).Text)
!jumlah = Val(TxtJumlah)
.Update
End With
Grid.DataSource = RsTmp
Grid.Refresh
Else
MsgBox "Barang Sudah Diinputkan."
Exit Sub
End If
CmbBarang =
""
TxtJumlah = 0
CmbBarang.SetFocus
End Sub
Private Sub
CmdSave_Click()
SQL =
"insert into Mutasi values('" & FormatTgl(TxtTgl) &
"','" & Trim(CmbAsal) & "','" & Trim(CmbTujuan)
& _
"','" & Trim(TxtKet) &
"')"
DbCon.Execute
SQL
RsTmp.MoveFirst
While Not
RsTmp.EOF
With RsTmp
SQL = "insert into DtlMutasi
values('" & FormatTgl(TxtTgl) & "','" & !noket &
"','" & _
!KodeBarang & "',"
& !jumlah & ")"
DbCon.Execute SQL
.MoveNext
End With
Wend
MsgBox
"Data Saved"
Bersih
End Sub
Private Sub
Form_Load()
Bersih
Adodc1.ConnectionString
= ConDB
With RsTmp
.Fields.Append "noKet",
adInteger, 4
.Fields.Append "KodeBarang",
adVarChar, 50
.Fields.Append "NamaBarang",
adVarChar, 50
.Fields.Append "Jumlah",
adInteger, 4
.Open
End With
End Sub
Sub Bersih()
TxtTgl = Date
CmbAsal =
""
CmbTujuan =
""
CmbBarang =
""
TxtJumlah = 0
End Sub
Private Sub
SSOleDBCombo1_GotFocus()
SendKeys
"{F4}"
End Sub
Private Sub
Grid_Click()
Keterangan1 =
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
RsTmp.Find
"noket='" & Keterangan1 & "'", , adSearchForward, 1
If Not
RsTmp.EOF Then
MsgBox RsTmp!noket & "
Dibatalkan"
RsTmp.Delete
End If
Keterangan1 = Keterangan1 + 1
RsTmp.Find "noket='" &
Keterangan1 & "'", , adSearchForward, 1
While Not RsTmp.EOF
With RsTmp
.Clone
!noket = !noket - 1
.Update
End With
RsTmp.MoveNext
Wend
Grid.Refresh
End If
End Sub
Private Sub
Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Keterangan1 =
Val(Me.Grid.Columns(0).Text)
End Sub
Private Sub
TxtJumlah_GotFocus()
cmbBarang_GotFocus
End Sub
Private Sub
TxtJumlah_KeyDown(KeyCode As Integer, Shift As Integer)
Enter KeyCode
End Sub
Private Sub
TxtKet_KeyDown(KeyCode As Integer, Shift As Integer)
Enter KeyCode
End Sub
Private Sub
vbButton1_Click()
Me.WindowState
= vbMinimized
End Sub
Private Sub
vbButton2_Click()
Unload Me
End Sub
Comments
Post a Comment