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

Popular posts from this blog

Flowchart Penjualan Grosir / Eceran