Modul
Public MyCN As New [Link]
Public MyRS As New [Link]
Public RSTemp As New [Link]
Public RSData As New [Link]
Public rscari As New [Link]
Public StrSQL As String
Public StrPesan As String
Public Function OpenDB() As Boolean
OpenDB = False
[Link] = adUseClient
[Link] "Provider=[Link].4.0;Data Source=" & [Link] & "\[Link]"
If [Link] = 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)
[Link] = LOG
[Link] = Not LOG
[Link] = Not LOG
[Link] = Not LOG
[Link] = 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()
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = 0
[Link] = 0
End Sub
Private Sub txtHarga_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
[Link]
End If
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If ([Link] = "") Or [Link]([Link]) < 5 Then
[Link]
Else
If SelectQuery(MyRS, "select * from tblbarang where [kode barang]='" & [Link] & "'")
Then
[Link] = [Link](1)
[Link] = [Link](2)
[Link] = [Link](3)
[Link] = [Link](4)
Call ActiveText(False)
Call Activecmd(False, True, True, True)
[Link]
Else
Call ActiveText(False)
Call Activecmd(True, False, False, True)
[Link]
End If
End If
End If
End Sub
Private Sub txtnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If [Link] = "" Then
[Link]
Else
[Link]
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('" & [Link] & "','" & [Link] & "'," & _
"'" & .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]='" & [Link] & "'")
StrSQL = "insert into tblbarang values('" & [Link] & "','" & [Link] & "'," & _
"'" & [Link]([Link], 5) & "'," & [Link] & "," & [Link] & ")"
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]='" & [Link] & "'")
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
[Link]
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]='" & [Link] & "'")
Then
MsgBox "Kode Barang tersebut sudah ada didalam database pengeluaran barang",
vbCritical, "Peringatan"
[Link]
Else
If [Link] = "" Then Exit Sub
StrSQL = "insert into tbltempkurang values('" & [Link] & "','" & [Link] & "'," & _
"" & [Link] & "," & [Link] & "," & Val([Link]) - Val([Link])
& ")"
Call SaveRecord(StrSQL)
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
[Link]
End If
Case 1
SelectQuery MyRS, "Select * from tbltempkurang"
If [Link] = 0 Then Exit Sub
Call DeleteRecord("delete * from tbltempkurang where [Kode Barang]='" &
[Link](0).Text & "'")
Call FillGrid("select * from tbltempkurang", Me.DataGrid1)
Call SetGrid
[Link]
End Select
End Sub
Private Sub DTTanggal_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then [Link]
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)
[Link] = LOG
[Link] = Not LOG
[Link] = 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()
[Link] = ""
[Link] = Date
[Link] = 0
[Link] = 0
End Sub
Private Sub txtBukti_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If ([Link] = "") Or Len([Link]) < 5 Then
[Link]
Else
Call ActiveText(False)
Call Activecmd(True, True, True, True)
[Link]
End If
End If
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Not [Link] = "" Then
If SelectQuery(MyRS, "select * from tblbarang where [kode barang]='" & [Link] & "'") Then
[Link] = MyRS![Nama Barang]
[Link] = MyRS!Stok
[Link]
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 [Link] = rpt
'
' [Link] = 100
' Caption = [Link]
'End Sub
Private Sub Form_Activate()
[Link]
End Sub
Private Sub Form_Resize()
[Link] = 0
[Link] = 0
[Link] = ScaleHeight
[Link] = ScaleWidth
End Sub
Form Menu
Private Declare Function InitCommonControls Lib "[Link]" () As Long
Private Sub Form_Activate()
Set [Link] = [Link](1).Picture
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Form_Load()
[Link] = [Link] + [Link](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)
[Link](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()
[Link] = [Link]([Link], 2) & [Link]([Link], 1, 1)
End Sub
Private Sub Timer2_Timer()
[Link](2).Text = Time
[Link](3).Text = [Link](Date, "dd / MMM / yyyy")
End Sub
Sub IsiMenu()
With XP
'Mengisi menu file master
.AddFrame "File Master", vbMain, vbOpen, 50, True, [Link](1).Picture
.AddButton 0, "File Data Satuan", 250, xpCustom, True, True, [Link](13).Picture, "Entry Data
Satuan"
.AddButton 0, "File Data Barang", 250, xpCustom, True, True, [Link](13).Picture, "Entry
Data Barang"
.AddButton 0, "Keluar", 250, xpCustom, True, True, [Link](13).Picture, "Keluar"
'Mengisi file transaksi
.AddFrame "Proses Stok", vbMain, vbclose, 50, True, [Link](2).Picture
.AddButton 1, "Penjualan Barang", 250, xpCustom, True, True, [Link](17).Picture, "Proses
Barang Keluar"
'Mengisi file Proses Laporan
.AddFrame "Cetak Laporan", vbMain, vbclose, 50, True, [Link](3).Picture
.AddButton 2, "Laporan Data Satuan", 250, xpCustom, True, True, [Link](15).Picture,
"Laporan Data Satuan"
.AddButton 2, "Laporan Data Barang", 250, xpCustom, True, True, [Link](15).Picture,
"Laporan Data Barang"
'.AddButton 2, "Laporan Data Penjualan Barang", 250, xpCustom, True, True,
[Link](15).Picture, "Laporan Data Penjualan Barang"
'.AddButton 2, "File Pembayaran Uang Sekolah", 250, xpCustom, True, True,
[Link](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
[Link] 1
Case 1
[Link] 1
Case 2
End
End Select
Case 1
Select Case Button
Case 0
[Link] 1
End Select
Case 2
Select Case Button
Case 0
Call PreviewReport(0)
Case 1
Call PreviewReport(1)
Case 2
[Link] 1
End Select
End Select
End Sub
Private Sub XP_ToolTipOver(Tip As String)
[Link](1).Text = Tip
End Sub
Sub PreviewReport(IntREP As Integer)
Dim rpt As Object
Dim FormPreview As New FormLaporan
Dim RSRep As New [Link]
Select Case IntREP
Case 0
Load ARVSatuan
[Link]
'Set rpt = New ARVSatuan
Case 1
Load ARVBarang
[Link]
'Set rpt = New ARVBarang
Case 2
[Link] "select * from tbltambah where [no bukti]='NB002'", MyCN, adOpenDynamic,
adLockOptimistic
Load ARVTambah
Set [Link] = RSRep
[Link]
'Set rpt = New ARVTambah
End Select
'[Link] rpt
'[Link]
End Sub
Sub AnimasiFlash()
' [Link] = [Link] & "\[Link]"
' [Link]
End Sub
Form Satuan
Dim xPil
Private Sub cmdNav_Click(Index As Integer)
Select Case Index
Case 0
StrSQL = "insert into tblsatuan values('" & [Link] & "','" & [Link] & "')"
Call SaveRecord(StrSQL)
Call cmdNav_Click(3)
Case 1
Call DeleteRecord("delete * from tblsatuan where [kode satuan]='" & [Link] & "'")
StrSQL = "insert into tblsatuan values('" & [Link] & "','" & [Link] & "')"
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]='" & [Link] & "'")
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
[Link]
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)
[Link] = LOG
[Link] = 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()
[Link] = ""
[Link] = ""
End Sub
Private Sub txtkode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If ([Link] = "") Or [Link]([Link]) < 5 Then
[Link]
Else
If SelectQuery(MyRS, "select * from tblsatuan where [kode satuan]='" & [Link] & "'")
Then
[Link] = [Link](1)
Call ActiveText(False)
Call Activecmd(False, True, True, True)
[Link]
Else
Call ActiveText(False)
Call Activecmd(True, False, False, True)
[Link]
End If
End If
End If
End Sub
Form Seleksi
Private Sub chk_Click()
If [Link] = vbcheked Then
[Link] = True
[Link] = False
Else
[Link] = False
[Link] = True
End If
End Sub
Private Sub cmdCetak_Click()
Dim RSRep As New [Link]
If [Link] = True Then
[Link] "select * from tbltambah where [no bukti]='" & [Link] & "'", MyCN,
adOpenDynamic, adLockOptimistic
Else
[Link] "select * from tbltambah where tanggal=#" & Format([Link],
"MM/dd/yyyy") & "#", MyCN, adOpenDynamic, adLockOptimistic
End If
' Load ARVTambah
' Set [Link] = RSRep
' [Link] 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]", [Link], False)
[Link] = Date
End Sub
Form Seleksi Kurang
Private Sub chk_Click()
If [Link] = vbcheked Then
[Link] = True
[Link] = False
Else
[Link] = False
[Link] = True
End If
End Sub
Private Sub cmdCetak_Click()
Dim RSRep As New [Link]
If [Link] = True Then
[Link] "select * from tblkurang where [no bukti]='" & [Link] & "'", MyCN,
adOpenDynamic, adLockOptimistic
Else
[Link] "select * from tblkurang where tanggal=#" & Format([Link],
"MM/dd/yyyy") & "#", MyCN, adOpenDynamic, adLockOptimistic
End If
' Load ARVKurang
' Set [Link] = RSRep
' [Link] 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]", [Link], False)
[Link] = Date
End Sub
