/ / Listing Inventory

Listing Inventory

Listing Modul
Public Konek As ADODB.Connection
Public MyRS As ADODB.Recordset
Public strSQL As String

Public Log_User As String
Public DMHS(99, 7) As String
Public A, B As Integer
Public codeShow, codeTransBeli As Boolean
Public codeForm As String
Public strCari As String

Public Sub KONEKSI()
Set Konek = New ADODB.Connection
Set MyRS = New ADODB.Recordset
'Konek.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\Dedy\Bahan Ajar\Algoritma\Algol2(2011)\Sisformik.mdb;Persist Security Info=False"
Konek.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=InventorySA02"
End Sub


Listing Login
Dim XX As Byte
Private Sub cmdBatal_Click()
End
End Sub
Private Sub cmdProses_Click()
Call KONEKSI
strSQL = "Select NIP,Nama,Pswd from mstPegawai where NIP='" & txtUser.Text & "' and Pswd='" & txtPassword.Text & "'"
MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
If Not MyRS.EOF Then
    Log_User = MyRS("NIP")
    Unload Me
    MDIFrmMenuUtama.Show
Else
    MsgBox "Maaf...User Atau Password Anda Salah, Masukan User Atau Password yang Benar...", vbOKOnly, "Peringatan!!!"
    XX = XX + 1
    If XX >= 3 Then
        End
    End If
    txtUser.Text = ""
    txtPassword.Text = ""
    txtUser.SetFocus
End If
End Sub

Private Sub Timer1_Timer()
    Tanggal.Caption = Format(Now, "dd-mm-yyyy")
    Jam.Caption = Format(Time, "hh:mm:ss")
    End Sub
Private Sub txtUser_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
    txtPassword.SetFocus
End If
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
    cmdProses_Click
End If
End Sub

Listing Menu Utama

Private Sub MDIForm_Load()
StatusBar1.Panels(1).Text = "User : " & Log_User
Call KONEKSI
strSQL = "Select * from Hak_Akses where NIP='" & Log_User & "'"
MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
If Not MyRS.EOF Then
mnuFile.Enabled = IIf(MyRS(1) = 1, True, False)
mnuDataBarang.Enabled = IIf(MyRS(2) = 1, True, False)
mnuDataSupplier.Enabled = IIf(MyRS(3) = 1, True, False)
mnuDataPelanggan.Enabled = IIf(MyRS(4) = 1, True, False)
mnuDataPegawai.Enabled = IIf(MyRS(5) = 1, True, False)
mnuUserAdmin.Enabled = IIf(MyRS(6) = 1, True, False)
mnuTransaksiPembelian.Enabled = IIf(MyRS(7) = 1, True, False)
mnuPO.Enabled = IIf(MyRS(8) = 1, True, False)
mnuROP.Enabled = IIf(MyRS(9) = 1, True, False)
mnuValidatePO.Enabled = IIf(MyRS(10) = 1, True, False)
mnuTransaksiPenjualan.Enabled = IIf(MyRS(11) = 1, True, False)
mnuTO.Enabled = IIf(MyRS(12) = 1, True, False)
mnuROT.Enabled = IIf(MyRS(13) = 1, True, False)
mnuLaporan.Enabled = IIf(MyRS(14) = 1, True, False)
mnuPembelian.Enabled = IIf(MyRS(15) = 1, True, False)
mnuPenjualan.Enabled = IIf(MyRS(16) = 1, True, False)
mnuBarang.Enabled = IIf(MyRS(17) = 1, True, False)
mnuSupplier.Enabled = IIf(MyRS(18) = 1, True, False)
mnuPelanggan.Enabled = IIf(MyRS(19) = 1, True, False)
mnuPegawai.Enabled = IIf(MyRS(20) = 1, True, False)
Else
mnuFile.Enabled = True
mnuDataBarang.Enabled = False
mnuDataSupplier.Enabled = False
mnuDataPelanggan.Enabled = False
mnuDataPegawai.Enabled = False
mnuUserAdmin.Enabled = False
mnuTransaksiPembelian.Enabled = False
mnuTransaksiPenjualan.Enabled = False
mnuLaporan.Enabled = False
End If
MyRS.Close: Set MyRS = Nothing
End Sub

Private Sub mnuAbaout_Click()
frmAbout.Show
End Sub

Private Sub mnuBarang_Click()
'crptLaporan.DataFiles(0) = App.Path & "\Db1.mdb"
'crptLaporan.ReportFileName = App.Path & "\Laporan\Barang.rpt"
'crptLaporan.SelectionFormula = "{Barang.Stok}<30" ' & cboCariKata.Text & "'"
'crptLaporan.RetrieveDataFiles
'crptLaporan.WindowState = crptMaximized
'crptLaporan.Destination = crptToWindow 'crptToPrinter
'crptLaporan.Action = 1
End Sub

Private Sub mnuDataBarang_Click()
frmBarang.Show
End Sub

Private Sub mnuDataPegawai_Click()
frmPegawai.Show
End Sub

Private Sub mnuDataSupplier_Click()
frmSupplier.Show
End Sub

Private Sub mnuKeluar_Click()
If MsgBox("Anda yakin ingin keluar dari aplikasi ini?!", vbYesNo, "Konfirmasi") = vbYes Then
    End
End If
End Sub

Private Sub mnuLogOff_Click()
Unload Me
frmLogin.Show
End Sub

Private Sub mnuPO_Click()
frmPembelian.Show
End Sub

Private Sub mnuUserAdmin_Click()
frmHakAkses.Show
End Sub

Private Sub Timer1_Timer()
If StatusBar1.Panels(2).Text <> "" Then
    StatusBar1.Panels(2).Text = ""
Else
    StatusBar1.Panels(2).Text = "Inventory STMI Jakarta " & Year(Date)
End If
End Sub


Listing Hak Akses
Dim CodeCeckCild As Boolean
Private Sub chkFile_Master_Click(Index As Integer)
If Index = 0 Then
    If chkFile_Master(0).Value = 1 Then
        If CodeCeckCild = False Then
            For A = 0 To 5
                chkFile_Master(A).Value = 1
            Next A
        End If
    Else
        For A = 0 To 5
            chkFile_Master(A).Value = 0
        Next A
    End If
Else
    If chkFile_Master(Index).Value = 1 Then
        CodeCeckCild = True: chkFile_Master(0).Value = 1
    End If
End If
CodeCeckCild = False
End Sub
Private Sub chkPembelian_Click(Index As Integer)
If Index = 0 Then
    If chkPembelian(0).Value = 1 Then
        If CodeCeckCild = False Then
            For A = 0 To 3
                chkPembelian(A).Value = 1
            Next A
        End If
    Else
        For A = 0 To 3
            chkPembelian(A).Value = 0
        Next A
    End If
Else
    If chkPembelian(Index).Value = 1 Then
        CodeCeckCild = True: chkPembelian(0).Value = 1
    End If
End If
CodeCeckCild = False
End Sub
Private Sub chkPenjualan_Click(Index As Integer)
If Index = 0 Then
    If chkPenjualan(0).Value = 1 Then
        If CodeCeckCild = False Then
            For A = 0 To 2
                chkPenjualan(A).Value = 1
            Next A
        End If
    Else
        For A = 0 To 2
            chkPenjualan(A).Value = 0
        Next A
    End If
Else
    If chkPenjualan(Index).Value = 1 Then
        CodeCeckCild = True: chkPenjualan(0).Value = 1
    End If
End If
CodeCeckCild = False
End Sub
Private Sub chkLaporan_Click(Index As Integer)
If Index = 0 Then
    If chkLaporan(0).Value = 1 Then
        If CodeCeckCild = False Then
            For A = 0 To 6
                chkLaporan(A).Value = 1
            Next A
        End If
    Else
        For A = 0 To 6
            chkLaporan(A).Value = 0
        Next A
    End If
Else
    If chkLaporan(Index).Value = 1 Then
        CodeCeckCild = True: chkLaporan(0).Value = 1
    End If
End If
CodeCeckCild = False
End Sub

Private Sub cmdBatal_Click()
Call Bersih
End Sub
Private Sub Bersih()
Dim objXX As Object
For Each objXX In Me
    If TypeName(objXX) = "CheckBox" Then
        objXX.Value = 0
    End If
Next
imgPicture.Picture = LoadPicture()
txtNama.Text = ""
cmdShow.SetFocus
codeShow = False
End Sub

Private Sub cmdCari_Click()
On Error GoTo Salah
If codeShow = False Then
    strCari = InputBox("Masukkan nip yang akan dicari?!", "Cari data")
Else
    strCari = Mid(Right(txtNama.Text, 10), 1, 9)
End If
If strCari = "" Then Exit Sub
strSQL = "Select * from Hak_Akses where nip='" & strCari & "'"
Call KONEKSI
MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
If MyRS.EOF Then
    MsgBox "Hak Akses Belum Diberikan!", vbExclamation, "Info"
    imgPicture.Picture = LoadPicture(App.Path & "/Foto/" & _
                     Mid(Right(txtNama.Text, 10), 1, 9) & ".jpg")
    Dim objXX As Object
    For Each objXX In Me
        If TypeName(objXX) = "CheckBox" Then
            objXX.Value = 0
        End If
    Next
Else
chkFile_Master(0).Value = Val(MyRS(1))
chkFile_Master(1).Value = Val(MyRS(2))
chkFile_Master(2).Value = Val(MyRS(3))
chkFile_Master(3).Value = Val(MyRS(4))
chkFile_Master(4).Value = Val(MyRS(5))
chkFile_Master(5).Value = Val(MyRS(6))
chkPembelian(0).Value = Val(MyRS(7))
chkPembelian(1).Value = Val(MyRS(8))
chkPembelian(2).Value = Val(MyRS(9))
chkPembelian(3).Value = Val(MyRS(10))
chkPenjualan(0).Value = Val(MyRS(11))
chkPenjualan(1).Value = Val(MyRS(12))
chkPenjualan(2).Value = Val(MyRS(13))
chkLaporan(0).Value = Val(MyRS(14))
chkLaporan(1).Value = Val(MyRS(15))
chkLaporan(2).Value = Val(MyRS(16))
chkLaporan(3).Value = Val(MyRS(17))
chkLaporan(4).Value = Val(MyRS(18))
chkLaporan(5).Value = Val(MyRS(19))
chkLaporan(6).Value = Val(MyRS(20))
imgPicture.Picture = LoadPicture(App.Path & "/Foto/" & strCari & ".jpg")
End If
MyRS.Close: Set MyRS = Nothing
Exit Sub
Salah:
imgPicture.Picture = LoadPicture()
End Sub

Private Sub cmdHapus_Click()
If txtNama.Text = "" Then Exit Sub
If MsgBox("Anda yakin ingin menghapus data ini ?", vbYesNo, _
          "Konfirmasi") = vbNo Then Exit Sub
Call KONEKSI
strSQL = "Select * from Hak_Akses where nip='" & Mid(Right(txtNama.Text, 10), 1, 9) & "'"
MyRS.Open strSQL, Konek, adOpenKeyset, adLockOptimistic
If MyRS.EOF Then
    MsgBox "Data yang akan dihapus tidak ditemukan !", vbExclamation, "Info"
Else
    MyRS.Delete
    MsgBox "Data telah terhapus !", vbInformation, "Info"
End If
Call Bersih
MyRS.Close: Set MyRS = Nothing
End Sub

Private Sub cmdKeluar_Click()
If MsgBox("Anda yakin ingin keluar?!", vbYesNo, "Konfirm") = vbYes Then Unload Me
End Sub

Private Sub cmdShow_Click()
codeForm = Me.Name
frmTampilData.Show
End Sub

Private Sub cmdSimpan_Click()
If txtNama.Text = "" Or Val(Mid(Right(txtNama.Text, 10), 1, 9)) = 0 Then
    MsgBox "Tampilkan dahulu datanya!", vbExclamation, "Info": Exit Sub
End If
Call KONEKSI
strSQL = "Select * From Hak_Akses where NIP='" & Mid(Right(txtNama.Text, 10), 1, 9) & "'"
MyRS.Open strSQL, Konek, adOpenKeyset, adLockOptimistic
If MyRS.EOF Then
    MyRS.AddNew
    MyRS(0) = Mid(Right(txtNama.Text, 10), 1, 9)
End If
MyRS(1) = IIf(chkFile_Master(0).Value = 0, 0, 1)
MyRS(2) = IIf(chkFile_Master(1).Value = 0, 0, 1)
MyRS(3) = IIf(chkFile_Master(2).Value = 0, 0, 1)
MyRS(4) = IIf(chkFile_Master(3).Value = 0, 0, 1)
MyRS(5) = IIf(chkFile_Master(4).Value = 0, 0, 1)
MyRS(6) = IIf(chkFile_Master(5).Value = 0, 0, 1)
MyRS(7) = IIf(chkPembelian(0).Value = 0, 0, 1)
MyRS(8) = IIf(chkPembelian(1).Value = 0, 0, 1)
MyRS(9) = IIf(chkPembelian(2).Value = 0, 0, 1)
MyRS(10) = IIf(chkPembelian(3).Value = 0, 0, 1)
MyRS(11) = IIf(chkPenjualan(0).Value = 0, 0, 1)
MyRS(12) = IIf(chkPenjualan(1).Value = 0, 0, 1)
MyRS(13) = IIf(chkPenjualan(2).Value = 0, 0, 1)
MyRS(14) = IIf(chkLaporan(0).Value = 0, 0, 1)
MyRS(15) = IIf(chkLaporan(1).Value = 0, 0, 1)
MyRS(16) = IIf(chkLaporan(2).Value = 0, 0, 1)
MyRS(17) = IIf(chkLaporan(3).Value = 0, 0, 1)
MyRS(18) = IIf(chkLaporan(4).Value = 0, 0, 1)
MyRS(19) = IIf(chkLaporan(5).Value = 0, 0, 1)
MyRS(20) = IIf(chkLaporan(6).Value = 0, 0, 1)
MyRS.Update
MyRS.Close: Set MyRS = Nothing
MsgBox "Data telah disimpan !", vbInformation, "Info"
Call Bersih
End Sub

Private Sub Form_Activate()
Me.Left = MDIFrmMenuUtama.ScaleWidth / 2 - Me.Width / 2
Me.Top = MDIFrmMenuUtama.ScaleHeight / 2 - Me.Height / 2
If codeShow = False Then
    Call Bersih
Else
    Call cmdCari_Click
End If

'On Error Resume Next
'imgPicture.Picture = LoadPicture(App.Path & "/Foto/" & Trim(Right(txtNama.Text, 10)) & ".jpg")
'imgPicture.Picture = LoadPicture(App.Path & "/Foto/" & _
                     Mid(Right(txtNama.Text, 10), 1, 9) & ".jpg")
End Sub

Listing Tampil Data
Private Sub cmdTutup_Click()
Unload Me
End Sub
Private Sub flxPGW_DblClick()
Dim strNIP As String
strNIP = flxPGW.TextMatrix(flxPGW.Row, 1)
If strNIP = "" Or strNIP = "NIP" Then MsgBox "No data selected!", vbCritical, "Error": Exit Sub
If codeForm <> "frmHakAkses" Then
    With frmPegawai
         codeShow = True
         strCari = strNIP
         '.cmdCari_Click
    End With
Else
    'With frmHakAkses
    '     .txtNama.Text = flxPGW.TextMatrix(flxPGW.Row, 2) & _
    '     Space(100) & flxPGW.TextMatrix(flxPGW.Row, 1)
    'End With
    codeShow = True
    With frmHakAkses
         .txtNama.Text = flxPGW.TextMatrix(flxPGW.Row, 2) & _
         Space(1) & "(" & flxPGW.TextMatrix(flxPGW.Row, 1) & ")"
    End With
End If
codeForm = ""
Unload Me
End Sub
Private Sub Form_Activate()
Me.Left = MDIFrmMenuUtama.ScaleWidth / 2 - Me.Width / 2
Me.Top = MDIFrmMenuUtama.ScaleHeight / 2 - Me.Height / 2
cboFields.Clear
strSQL = "Select * from mstPegawai"
Call KONEKSI
MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
For A = 0 To MyRS.Fields.Count - 1
    cboFields.AddItem MyRS.Fields(A).Name
Next A
cboKriteria.Clear
cboKriteria.AddItem "=": cboKriteria.AddItem "Like"
Call HeaderFlex
With flxPGW
    .Rows = 1: A = 0
    If Not MyRS.EOF Then MyRS.MoveFirst
    Do While Not MyRS.EOF
        .Rows = .Rows + 1
        .TextMatrix(A + 1, 0) = A + 1
        .TextMatrix(A + 1, 1) = MyRS(0): .TextMatrix(A + 1, 2) = MyRS(1)
        .TextMatrix(A + 1, 3) = MyRS(2): .TextMatrix(A + 1, 4) = MyRS(3)
        .TextMatrix(A + 1, 5) = MyRS(4): .TextMatrix(A + 1, 6) = MyRS(5)
        .TextMatrix(A + 1, 7) = MyRS(6): .TextMatrix(A + 1, 8) = MyRS(7)
        .TextMatrix(A + 1, 9) = MyRS(8): .TextMatrix(A + 1, 10) = MyRS(9)
        .TextMatrix(A + 1, 11) = MyRS(10)
        A = A + 1: MyRS.MoveNext
    Loop
    MyRS.Close: Set MyRS = Nothing
End With
cboFields.SetFocus
End Sub
Private Sub cboFields_Click()
cboKriteria.SetFocus
End Sub
Private Sub cboKriteria_Click()
txtCari.SetFocus
End Sub

Private Sub txtCari_Change()
'Call TampilData
End Sub

Private Sub txtCari_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call TampilData
End If
End Sub
Private Sub TampilData()
If cboKriteria.Text = "Like" Then
    strSQL = "Select * from mstPegawai where " & cboFields.Text & " " & _
             cboKriteria.Text & " '%" & txtCari.Text & "%' order by nama asc"
ElseIf cboKriteria.Text = "=" Then
    strSQL = "Select * from mstPegawai where " & cboFields.Text & " " & _
             cboKriteria.Text & " '" & txtCari.Text & "' order by nama asc"
Else
    strSQL = "Select * from mstPegawai where " & cboFields.Text & " " & _
             cboKriteria.Text & " " & txtCari.Text & " order by nama asc"
End If
Call KONEKSI
    MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
    If MyRS.EOF Then
        Call HeaderFlex
        MyRS.Close: Set MyRS = Nothing: Exit Sub
    Else
        Call HeaderFlex
        flxPGW.Rows = 1: A = 0
        MyRS.MoveFirst
        Do While Not MyRS.EOF
            flxPGW.Rows = flxPGW.Rows + 1
            flxPGW.TextMatrix(A + 1, 0) = A + 1
            flxPGW.TextMatrix(A + 1, 1) = MyRS(0): flxPGW.TextMatrix(A + 1, 2) = MyRS(1)
            flxPGW.TextMatrix(A + 1, 3) = MyRS(2): flxPGW.TextMatrix(A + 1, 4) = MyRS(3)
            flxPGW.TextMatrix(A + 1, 5) = MyRS(4): flxPGW.TextMatrix(A + 1, 6) = MyRS(5)
            flxPGW.TextMatrix(A + 1, 7) = MyRS(6): flxPGW.TextMatrix(A + 1, 8) = MyRS(7)
            flxPGW.TextMatrix(A + 1, 9) = MyRS(8): flxPGW.TextMatrix(A + 1, 10) = MyRS(9)
            flxPGW.TextMatrix(A + 1, 11) = MyRS(10)
            A = A + 1: MyRS.MoveNext
        Loop
        MyRS.Close: Set MyRS = Nothing
    End If
End Sub
Public Sub HeaderFlex()
flxPGW.Clear
flxPGW.FormatString = "^No.  |<NIP             |<Nama Pegawai          |^Jns Kel |<Tempat Lahir                               |<Tanggal Lahir    |<Alamat                           |<Kota                    |<Kode Pos     |<No Telpon             |<Hand Phone1         |<Hand Phone2         |"
flxPGW.Cols = 12
flxPGW.Rows = 2
End Sub

Private Sub txtSelectScript_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    On Error GoTo Salah
    strSQL = txtSelectScript.Text
    Call KONEKSI
    MyRS.Open strSQL, Konek, adOpenKeyset, adLockReadOnly
    If MyRS.EOF Then
        MsgBox "No data selected !", vbInformation, "Info"
        Call HeaderFlex
        MyRS.Close: Set MyRS = Nothing: Exit Sub
    Else
        Call HeaderFlex
        flxPGW.Rows = 1: A = 0
        MyRS.MoveFirst
        Do While Not MyRS.EOF
            flxPGW.Rows = flxPGW.Rows + 1
            flxPGW.TextMatrix(A + 1, 0) = A + 1
            flxPGW.TextMatrix(A + 1, 1) = MyRS(0)
            flxPGW.TextMatrix(A + 1, 2) = MyRS(1)
            flxPGW.TextMatrix(A + 1, 3) = MyRS(2)
            flxPGW.TextMatrix(A + 1, 4) = MyRS(3)
            flxPGW.TextMatrix(A + 1, 5) = MyRS(4)
            flxPGW.TextMatrix(A + 1, 6) = MyRS(5)
            flxPGW.TextMatrix(A + 1, 7) = MyRS(6)
            flxPGW.TextMatrix(A + 1, 8) = MyRS(7)
            flxPGW.TextMatrix(A + 1, 9) = MyRS(8)
            flxPGW.TextMatrix(A + 1, 10) = MyRS(9)
            flxPGW.TextMatrix(A + 1, 11) = MyRS(10)
            A = A + 1: MyRS.MoveNext
        Loop
        MyRS.Close: Set MyRS = Nothing
    End If
    Exit Sub
Salah:
MsgBox "Select script yang anda ketikkan salah !", vbInformation, "Info"
Call HeaderFlex: 'MyRS.Close: Set MyRS = Nothing
txtSelectScript.SetFocus
End If

End Sub
Share on Google Plus

About Unknown

Nama saya adalah Gifari Alfan Reza, seorang yang tak luput dari kesalahan dan juga membutuhkan orang lain dalam menjalani hidup ini karena manusia tidak sendiri. Saya yang berkeinginan bisa pergi keluar negeri itu sangat itu aku inginkan "Bersemangatlah field in the user admin panel.
    Blogger Comment
    Facebook Comment

0 komentar:

Posting Komentar

Langganan: Posting Komentar ( Atom )