Modul
Public MyCN As New ADODB.Connection
Public MyRS As New ADODB.Recordset
Public RSTemp As New ADODB.Recordset
Public RSData As New ADODB.Recordset
Public rscari As New ADODB.Recordset
Public StrSQL As String
Public StrPesan As String
Public Function OpenDB() As Boolean
OpenDB = False
MyCN.CursorLocation = adUseClient
MyCN.Open "Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & App.Path & "\Stok.mdb"
If MyCN.State = adStateOpen Then
OpenDB = True
End If
End Function
Form Stock Barang
Private Sub Form_Load()
Call Center(Me)
xPil = 0
Call ActiveText(True)
Call Activecmd(False, False, False, True)
Call AddToCombo("select * from tblsatuan", cboSatuan)
Call FillGrid("select * from tblbarang", Me.DataGrid1)
Call SetGrid
End Sub
Sub ActiveText(LOG As Boolean)
txtkode.Enabled = LOG
txtnama.Enabled = Not LOG
cboSatuan.Enabled = Not LOG
txtHarga.Enabled = Not LOG
txtStok.Enabled = Not LOG
End Sub
Sub Activecmd(L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
cmdNav(0).Enabled = L0
cmdNav(1).Enabled = L1
cmdNav(2).Enabled = L2
cmdNav(3).Enabled = L3
End Sub
Sub SetGrid()
With Me.DataGrid1
.Columns(0).Caption = " Kode Barang"
.Columns(0).Width = 1500
.Columns(0).Alignment = dbgCenter
.Columns(1).Caption = " Nama Barang"
.Columns(1).Width = 2500
.Columns(1).Alignment = dbgLeft
.Columns(2).Caption = " Kode Satuan"
.Columns(2).Width = 1300
.Columns(2).Alignment = dbgCenter
.Columns(3).Caption = " Harga"
.Columns(3).Width = 1500
.Columns(3).Alignment = dbgRight
.Columns(4).Caption = " Stok"
.Columns(4).Width = 1000
.Columns(4).Alignment = dbgCenter
End With
End Sub
Sub ClearText()
txtkode.Text = ""
txtnama.Text = ""
cboSatuan.Text = ""
txtHarga.Text = 0
txtStok.Text = 0
End Sub
Private Sub txtHarga_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtStok.SetFocus
End If
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If (txtkode.Text = "") Or VBA.Len(txtkode.Text) < 5 Then
txtkode.SetFocus
Else
If SelectQuery(MyRS, "select * from tblbarang where [kode barang]='" & Me.txtkode.Text & "'")
Then
txtnama.Text = MyRS.Fields(1)
cboSatuan.Text = MyRS.Fields(2)
txtHarga.Text = MyRS.Fields(3)
txtStok.Text = MyRS.Fields(4)
Call ActiveText(False)
Call Activecmd(False, True, True, True)
txtnama.SetFocus
Else
Call ActiveText(False)
Call Activecmd(True, False, False, True)
txtnama.SetFocus
End If
End If
End If
End Sub
Private Sub txtnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If txtnama.Text = "" Then
txtnama.SetFocus
Else
cboSatuan.SetFocus
End If
End If
End Sub
Private Sub txtStok_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Form Keluar Barang
Dim xPil
Private Sub cmdNav_Click(Index As Integer)
Select Case Index
Case 0
SelectQuery RSTemp, "select * from tbltempkurang"
With RSTemp
If .RecordCount = 0 Then Exit Sub
.MoveFirst
Do While Not .EOF
StrSQL = "insert into tblkurang values('" & txtBukti.Text & "','" & DTTanggal.Value & "'," & _
"'" & .Fields(0) & "','" & .Fields(1) & "'," & .Fields(2) & "," & .Fields(3) & "," & .Fields(4) &
")"
Call SaveRecord(StrSQL)
StrSQL = "update tblbarang set stok=stok - " & .Fields(3) & " where [Kode Barang]='" &
.Fields(0) & "'"
Call SaveRecord(StrSQL)
.MoveNext
Loop
End With
MsgBox "Record berhasil disimpan semua", vbOKOnly, "Pesan"
Call cmdNav_Click(3)
Case 1
Call DeleteRecord("delete * from tblbarang where [kode barang]='" & txtkode.Text & "'")
StrSQL = "insert into tblbarang values('" & txtkode.Text & "','" & txtnama.Text & "'," & _
"'" & VBA.Left(cboSatuan.Text, 5) & "'," & txtHarga.Text & "," & txtStok.Text & ")"
Call SaveRecord(StrSQL)
Call cmdNav_Click(3)
Case 2
StrPesan = MsgBox("Apakah anda yakin ingin menghapus record ini?", vbExclamation + vbYesNo,
"Konfirmasi")
If StrPesan = vbYes Then
Call DeleteRecord("delete * from tblbarang where [kode barang]='" & txtkode.Text & "'")
MsgBox "Record berhasil dihapus", vbOKOnly, "Pesan"
Call cmdNav_Click(3)
End If
Case 3
Call ClearText
Call ActiveText(True)
Call Activecmd(False, False, False, True)
Call DeleteRecord("delete * from tbltempkurang")
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
txtBukti.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub cmdNav_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As
Single)
' cmdNav(xPil).FontBold = False
' cmdNav(Index).FontBold = True
' xPil = Index
End Sub
Private Sub cmdVal_Click(Index As Integer)
Select Case Index
Case 0
If SelectQuery(MyRS, "select * from tbltempkurang where [kode barang]='" & txtkode.Text & "'")
Then
MsgBox "Kode Barang tersebut sudah ada didalam database pengeluaran barang",
vbCritical, "Peringatan"
txtkode.SetFocus
Else
If txtBukti.Text = "" Then Exit Sub
StrSQL = "insert into tbltempkurang values('" & txtkode.Text & "','" & txtnama.Text & "'," & _
"" & txtStokAwal.Text & "," & txtStok.Text & "," & Val(txtStokAwal.Text) - Val(txtStok.Text)
& ")"
Call SaveRecord(StrSQL)
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
txtkode.SetFocus
End If
Case 1
SelectQuery MyRS, "Select * from tbltempkurang"
If MyRS.RecordCount = 0 Then Exit Sub
Call DeleteRecord("delete * from tbltempkurang where [Kode Barang]='" &
Me.DataGrid1.Columns(0).Text & "'")
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
txtkode.SetFocus
End Select
End Sub
Private Sub DTTanggal_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtkode.SetFocus
End Sub
Private Sub Form_Load()
Call Center(Me)
xPil = 0
Call ClearText
Call ActiveText(True)
Call Activecmd(False, False, False, True)
Call DeleteRecord("delete * from tbltempkurang")
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
End Sub
Sub ActiveText(LOG As Boolean)
txtBukti.Enabled = LOG
DTTanggal.Enabled = Not LOG
txtStok.Enabled = Not LOG
End Sub
Sub Activecmd(L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
cmdNav(0).Enabled = L0
cmdNav(1).Enabled = L1
cmdNav(2).Enabled = L2
cmdNav(3).Enabled = L3
End Sub
Sub SetGrid()
With Me.DataGrid1
.Columns(0).Caption = " No Barcode"
.Columns(0).Width = 2500
.Columns(0).Alignment = dbgCenter
.Columns(1).Caption = " Nama Barang"
.Columns(1).Width = 2500
.Columns(1).Alignment = dbgLeft
.Columns(2).Caption = " Stok"
.Columns(2).Width = 1000
.Columns(2).Alignment = dbgCenter
.Columns(3).Caption = " Jlh Keluar"
.Columns(3).Width = 1300
.Columns(3).Alignment = dbgCenter
.Columns(4).Caption = " Stok Akhir"
.Columns(4).Width = 1000
.Columns(4).Alignment = dbgCenter
End With
End Sub
Sub ClearText()
txtBukti.Text = ""
DTTanggal.Value = Date
txtStokAwal.Text = 0
txtStok.Text = 0
End Sub
Private Sub txtBukti_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If (txtBukti.Text = "") Or Len(txtBukti.Text) < 5 Then
txtBukti.SetFocus
Else
Call ActiveText(False)
Call Activecmd(True, True, True, True)
DTTanggal.SetFocus
End If
End If
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Not txtkode.Text = "" Then
If SelectQuery(MyRS, "select * from tblbarang where [kode barang]='" & txtkode.Text & "'") Then
txtnama.Text = MyRS![Nama Barang]
txtStokAwal.Text = MyRS!Stok
txtStok.SetFocus
End If
End If
End If
End Sub
Private Sub txtStok_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Form Laporan
'Public Sub RunReport(rpt As Object)
' Set ARV.ReportSource = rpt
'
' ARV.Zoom = 100
' Caption = rpt.Caption
'End Sub
Private Sub Form_Activate()
Me.ARV.SetFocus
End Sub
Private Sub Form_Resize()
ARV.Top = 0
ARV.Left = 0
ARV.Height = ScaleHeight
ARV.Width = ScaleWidth
End Sub
Form Menu
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Private Sub Form_Activate()
Set Me.Icon = Me.IMG1.ListImages(1).Picture
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Form_Load()
Me.Caption = Me.Caption + VBA.Space(110)
Call IsiMenu
Call OpenDB
Call AnimasiFlash
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.StatusBar1.Panels(1).Text = "Copyright By Ari"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Frame1_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
End Sub
Private Sub Timer1_Timer()
Me.Caption = VBA.Mid(Me.Caption, 2) & VBA.Mid(Me.Caption, 1, 1)
End Sub
Private Sub Timer2_Timer()
Me.StatusBar1.Panels(2).Text = Time
Me.StatusBar1.Panels(3).Text = VBA.Format(Date, "dd / MMM / yyyy")
End Sub
Sub IsiMenu()
With XP
'Mengisi menu file master
.AddFrame "File Master", vbMain, vbOpen, 50, True, IMG1.ListImages(1).Picture
.AddButton 0, "File Data Satuan", 250, xpCustom, True, True, IMG1.ListImages(13).Picture, "Entry Data
Satuan"
.AddButton 0, "File Data Barang", 250, xpCustom, True, True, IMG1.ListImages(13).Picture, "Entry
Data Barang"
.AddButton 0, "Keluar", 250, xpCustom, True, True, IMG1.ListImages(13).Picture, "Keluar"
'Mengisi file transaksi
.AddFrame "Proses Stok", vbMain, vbclose, 50, True, IMG1.ListImages(2).Picture
.AddButton 1, "Penjualan Barang", 250, xpCustom, True, True, IMG1.ListImages(17).Picture, "Proses
Barang Keluar"
'Mengisi file Proses Laporan
.AddFrame "Cetak Laporan", vbMain, vbclose, 50, True, IMG1.ListImages(3).Picture
.AddButton 2, "Laporan Data Satuan", 250, xpCustom, True, True, IMG1.ListImages(15).Picture,
"Laporan Data Satuan"
.AddButton 2, "Laporan Data Barang", 250, xpCustom, True, True, IMG1.ListImages(15).Picture,
"Laporan Data Barang"
'.AddButton 2, "Laporan Data Penjualan Barang", 250, xpCustom, True, True,
IMG1.ListImages(15).Picture, "Laporan Data Penjualan Barang"
'.AddButton 2, "File Pembayaran Uang Sekolah", 250, xpCustom, True, True,
IMG1.ListImages(17).Picture, "Pengisian absensi siswa"
End With
End Sub
Private Sub XP_Action(Frame As Integer, Button As Integer)
Select Case Frame
Case 0
Select Case Button
Case 0
FormSatuan.Show 1
Case 1
FormBarang.Show 1
Case 2
End
End Select
Case 1
Select Case Button
Case 0
FormKeluarBarang.Show 1
End Select
Case 2
Select Case Button
Case 0
Call PreviewReport(0)
Case 1
Call PreviewReport(1)
Case 2
FormSeleksiKurang.Show 1
End Select
End Select
End Sub
Private Sub XP_ToolTipOver(Tip As String)
Me.StatusBar1.Panels(1).Text = Tip
End Sub
Sub PreviewReport(IntREP As Integer)
Dim rpt As Object
Dim FormPreview As New FormLaporan
Dim RSRep As New ADODB.Recordset
Select Case IntREP
Case 0
Load ARVSatuan
ARVSatuan.Show
'Set rpt = New ARVSatuan
Case 1
Load ARVBarang
ARVBarang.Show
'Set rpt = New ARVBarang
Case 2
RSRep.Open "select * from tbltambah where [no bukti]='NB002'", MyCN, adOpenDynamic,
adLockOptimistic
Load ARVTambah
Set ARVTambah.DataControl1.Recordset = RSRep
ARVTambah.Show
'Set rpt = New ARVTambah
End Select
'FormPreview.RunReport rpt
'FormPreview.Show
End Sub
Sub AnimasiFlash()
' swf.Movie = App.Path & "\Flash.swf"
' swf.Play
End Sub
Form Satuan
Dim xPil
Private Sub cmdNav_Click(Index As Integer)
Select Case Index
Case 0
StrSQL = "insert into tblsatuan values('" & txtkode.Text & "','" & txtnama.Text & "')"
Call SaveRecord(StrSQL)
Call cmdNav_Click(3)
Case 1
Call DeleteRecord("delete * from tblsatuan where [kode satuan]='" & txtkode.Text & "'")
StrSQL = "insert into tblsatuan values('" & txtkode.Text & "','" & txtnama.Text & "')"
Call SaveRecord(StrSQL)
Call cmdNav_Click(3)
Case 2
StrPesan = MsgBox("Apakah anda yakin ingin menghapus record ini?", vbExclamation + vbYesNo,
"Konfirmasi")
If StrPesan = vbYes Then
Call DeleteRecord("delete * from tblsatuan where [kode satuan]='" & txtkode.Text & "'")
MsgBox "Reciord berhasil dihapus", vbOKOnly, "Pesan"
Call cmdNav_Click(3)
End If
Case 3
Call ClearText
Call ActiveText(True)
Call Activecmd(False, False, False, True)
Call FillGrid("select * from tblsatuan", Me.DataGrid1)
Call SetGrid
txtkode.SetFocus
Case 4
Unload Me
End Select
End Sub
'
'Private Sub cmdNav_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As
Single)
' cmdNav(xPil).FontBold = False
' cmdNav(Index).FontBold = True
' xPil = Index
'End Sub
Private Sub Form_Load()
Call Center(Me)
xPil = 0
Call ActiveText(True)
Call Activecmd(False, False, False, True)
Call FillGrid("select * from tblsatuan", Me.DataGrid1)
Call SetGrid
End Sub
Sub ActiveText(LOG As Boolean)
txtkode.Enabled = LOG
txtnama.Enabled = Not LOG
End Sub
Sub Activecmd(L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
cmdNav(0).Enabled = L0
cmdNav(1).Enabled = L1
cmdNav(2).Enabled = L2
cmdNav(3).Enabled = L3
End Sub
Sub SetGrid()
With Me.DataGrid1
.Columns(0).Caption = " Kode Satuan"
.Columns(0).Width = 1500
.Columns(0).Alignment = dbgCenter
.Columns(1).Caption = " Nama Satuan"
.Columns(1).Width = 2500
.Columns(1).Alignment = dbgLeft
End With
End Sub
Sub ClearText()
txtkode.Text = ""
txtnama.Text = ""
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If (txtkode.Text = "") Or VBA.Len(txtkode.Text) < 5 Then
txtkode.SetFocus
Else
If SelectQuery(MyRS, "select * from tblsatuan where [kode satuan]='" & Me.txtkode.Text & "'")
Then
txtnama.Text = MyRS.Fields(1)
Call ActiveText(False)
Call Activecmd(False, True, True, True)
txtnama.SetFocus
Else
Call ActiveText(False)
Call Activecmd(True, False, False, True)
txtnama.SetFocus
End If
End If
End If
End Sub
Form Seleksi
Private Sub chk_Click()
If chk.Value = vbcheked Then
Frame1.Visible = True
Frame2.Visible = False
Else
Frame1.Visible = False
Frame2.Visible = True
End If
End Sub
Private Sub cmdCetak_Click()
Dim RSRep As New ADODB.Recordset
If Frame1.Visible = True Then
RSRep.Open "select * from tbltambah where [no bukti]='" & cbobukti.Text & "'", MyCN,
adOpenDynamic, adLockOptimistic
Else
RSRep.Open "select * from tbltambah where tanggal=#" & Format(Me.DTPicker1.Value,
"MM/dd/yyyy") & "#", MyCN, adOpenDynamic, adLockOptimistic
End If
' Load ARVTambah
' Set ARVTambah.DataControl1.Recordset = RSRep
' ARVTambah.Show 1
End Sub
Private Sub CMDEND_Click()
Unload Me
End Sub
Private Sub Form_Load()
Call AddToCombo("select distinct [no bukti] from tbltambah order by [no bukti]", Me.cbobukti, False)
Me.DTPicker1.Value = Date
End Sub
Form Seleksi Kurang
Private Sub chk_Click()
If chk.Value = vbcheked Then
Frame1.Visible = True
Frame2.Visible = False
Else
Frame1.Visible = False
Frame2.Visible = True
End If
End Sub
Private Sub cmdCetak_Click()
Dim RSRep As New ADODB.Recordset
If Frame1.Visible = True Then
RSRep.Open "select * from tblkurang where [no bukti]='" & cbobukti.Text & "'", MyCN,
adOpenDynamic, adLockOptimistic
Else
RSRep.Open "select * from tblkurang where tanggal=#" & Format(Me.DTPicker1.Value,
"MM/dd/yyyy") & "#", MyCN, adOpenDynamic, adLockOptimistic
End If
' Load ARVKurang
' Set ARVKurang.DataControl1.Recordset = RSRep
' ARVKurang.Show 1
End Sub
Private Sub CMDEND_Click()
Unload Me
End Sub
M Private Sub Form_Load()
Call AddToCombo("select distinct [no bukti] from tblkurang order by [no bukti]", Me.cbobukti, False)
Me.DTPicker1.Value = Date
End Sub
