APLIKASI PENJUALAN DENGAN VISUAL BASIC 6.0

FORM LOGGIN

    

Dim WithEvents recUser As ADODB.Recordset

Dim buff_Pwd As String

Dim buff_Status, buff_Val, buff_ID

Dim CONN As ADODB.Connection

Private Sub cmdsetuser_Click()

frmUserId.Show

End Sub

Private Sub Command1_Click()

If TXTUSERID <> "" Then

   If TXTPWD <> "" Then

      Set recUser = New ADODB.Recordset

      recUser.Open "UserID", CONN, 3, 2

      Set recUser = CONN.Execute("SELECT * From UserId where [UserID]='" & TXTUSERID & "'")

          If recUser.EOF = False Then

              buff_Pwd = recUser!Password

              If Trim(TXTPWD) <> buff_Pwd Then

                 Me.Hide

                 MsgBox "Data yang anda masukan salah" & vbCrLf & _

                        "Silahkan mencoba lagi !!!", vbInformation, "Log-In USER"

                 Me.Show

                 TXTUSERID = "": TXTPWD = ""

                 TXTUSERID.SetFocus

                Else

                 On Error GoTo UpdateUserErorr

                MDIForm1.dad.Enabled = True

                MDIForm1.fdfd.Enabled = True

                MDIForm1.lol.Enabled = False

                Unload Me

              End If

            Else

             Me.Hide

             MsgBox "Data yang anda masukan salah" & vbCrLf & _

                    "Silahkan mencoba lagi !!!", vbInformation, "Log-In USER"

             Me.Show

             TXTUSERID = "": TXTPWD = ""

             TXTUSERID.SetFocus

          End If

          Else

     TXTPWD.SetFocus

   End If

  Else

   TXTUSERID.SetFocus

End If

Exit Sub

UpdateUserErorr:

   MsgBox Err.Description

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

Set CONN = New ADODB.Connection

CONN.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\data.mdb"

End Sub

Private Sub TXTPWD_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   If TXTPWD = "" Then

      TXTPWD.SetFocus

       Else

   If TXTUSERID = "Admin" And TXTPWD = "Admin" Then

      cmdsetuser.Enabled = True

End If

End If

End If

End Sub

FORM BARANG

Dim db As ADODB.Connection

Dim rspemasok As ADODB.Recordset

Private Sub cmbkdbrg_Click()

'koneksi tabel

Set rspemasok = New ADODB.Recordset

rspemasok.Open "SELECT * FROM pemasok Order By Kodepemasok", db, 3, 2

Set rspemasok = db.Execute("select * from pemasok where kodebarang = '" & cmbkdbrg & "'")

If rspemasok.EOF = False Then

   txtnmbrg = rspemasok.Fields(5)

End If

cmdsimpan.SetFocus

End Sub

Private Sub cmdbaru_Click()

Bersih Me

cmbkdbrg.SetFocus

End Sub

Private Sub cmdBatal_Click()

Bersih Me

cmbkdbrg.SetFocus

End Sub

Private Sub cmdhapus_Click()

'hapus data

Pesan = InputBox("masukan No Barang")

If Pesan <> "" Then

Dim conf

conf = MsgBox("Anda yakin akan menghapus data??", vbQuestion + vbYesNo)

If conf = vbYes Then

db.Execute "delete * from barang where kodebarang ='" & Pesan & "' "

MsgBox ("Data telah dihapus")

End If

End If

End Sub

Private Sub cmdkeluar_Click()

Unload Me

End Sub

Private Sub cmdLaporan_Click()

crpt.DataFiles(0) = App.Path & "\Data.mdb"

crpt.ReportFileName = App.Path & "\barang.rpt"

crpt.Destination = crptToWindow

crpt.WindowState = crptMaximized

crpt.Action = 1

End Sub

Private Sub cmdsimpan_Click()

Dim conf

conf = MsgBox("Simpan Data barang ?", vbQuestion + vbYesNo)

If conf = vbYes Then

'simpan data

Set rsbarang = New ADODB.Recordset

rsbarang.Open "SELECT * FROM barang Order By Kodebarang", db, 3, 2

db.Execute "insert into barang values('" & cmbkdbrg & "','" & txtnmbrg & "', '" & txtjnsbrg & "', '" & txthrg & "', '" & txtstok & "')"

Bersih Me

cmdbaru.SetFocus

End If

End Sub

Private Sub Form_Load()

Set db = New ADODB.Connection

db.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0;Data Source=" & App.Path & "\Data.mdb"

Set rspemasok = New ADODB.Recordset

rspemasok.Open "SELECT * FROM pemasok Order By kodepemasok", db, 3, 2

If rspemasok.RecordCount <> 0 Then

rspemasok.MoveFirst

For i = 1 To rspemasok.RecordCount

    cmbkdbrg.AddItem rspemasok.Fields(4)

    rspemasok.MoveNext

Next i

End If

End Sub

FORM KASIR

 

RUMUS FORM KASIR OTOMATIS

  

RUMUS OTOMATIS

FORM PEMASOK

 

RUMUS OTOMATIS

FORM PENJUALAN

  

Dim db As ADODB.Connection

Dim rskasir As ADODB.Recordset

Dim rsbarang As ADODB.Recordset

Dim rshpenjualan As ADODB.Recordset

Dim rsdpenjualan As ADODB.Recordset

Private Sub cmbkdbarang_Click()

'koneksi tabel

Set rsbarang = New ADODB.Recordset

rsbarang.Open "SELECT * FROM barang Order By Kodebarang", db, 3, 2

Set rsbarang = db.Execute("select * from barang where kodebarang = '" & cmbkdbarang & "'")

If rsbarang.EOF = False Then

   txtnamabarang = rsbarang.Fields(1)

   txtharga = rsbarang.Fields(3)

   txtjumlah.SetFocus

End If

txtjumlah.SetFocus

End Sub

Private Sub cmbkdkasir_Click()

'koneksi tabel

Set rskasir = New ADODB.Recordset

rskasir.Open "SELECT * FROM kasir Order By Kodekasir", db, 3, 2

Set rskasir = db.Execute("select * from kasir where kodekasir = '" & cmbkdkasir & "'")

If rskasir.EOF = False Then

   txtnama = rskasir.Fields(1)

End If

cmdsimpan.SetFocus

End Sub

Private Sub cmdBarang_Click()

Frmbarang.Show

End Sub

Private Sub cmdbaru_Click()

NOfaktur_OTOMATIS

txttanggal = Format(Date, "DD/MM/YYYY")

txtperiode = Format(Date, "MMMM")

db.Execute "DELETE * FROM BUFFER"

End Sub

Public Sub NOfaktur_OTOMATIS()

Set rspenjualan = New ADODB.Recordset

rspenjualan.Open "hpenjualan", db, 3, 2

If rspenjualan.RecordCount = 0 Then

   txtnofaktur = Format(Date, "yymm") + "/PJ/001"

  Else

   rspenjualan.MoveLast

   If Left(rspenjualan.Fields(0), 4) = Format(Date, "yymm") Then

      txtnofaktur = Trim(Str(Val(Right(rspenjualan.Fields(0), 3)) + 1))

      txtnofaktur = Format(Date, "yymm") + "/PJ/" + Left("000", 3 - Len(txtnofaktur)) + txtnofaktur

    Else

      txtnofaktur = Format(Date, "yymm") + "/PJ/001"

   End If

End If

End Sub

Private Sub cmdBatal_Click()

Bersih Me

End Sub

Private Sub cmdkeluar_Click()

Unload Me

End Sub

Private Sub cmdKonsumen_Click()

frmKasir.Show

End Sub

Private Sub cmdLaporan_Click()

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.ReportFileName = App.Path & "\penjualan.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub cmdsimpan_Click()

Dim conf

conf = MsgBox("Simpan data di atas ?", vbQuestion + vbYesNo)

If conf = vbYes Then

   'simpn data head

   db.Execute "insert into hpenjualan values('" & txtnofaktur & "','" & _

              txttanggal & "','" & txtperiode & "','" & cmbkdkasir & "','" & txtnama & "')"

   'simpan data detail

   db.Execute "insert into dpenjualan select * from buffer"

   End If

   Bersih Me

   End Sub

Private Sub Command1_Click()

'hapus data

Pesan = InputBox("Masukan No Faktur")

If Pesan <> "" Then

Dim conf

conf = MsgBox("Anda yakin akan menghapus data?", vbQuestion + vbYesNo)

If conf = vbYes Then

db.Execute "DELETE * from hpenjualan where nofactur = '" & Pesan & "' "

db.Execute "DELETE * from dpenjualan where nofactur = '" & Pesan & "' "

db.Execute "DELETE * from buffer where nofactur = '" & Pesan & "' "

MsgBox ("Data telah dihapus")

End If

End If

End Sub

Private Sub Form_Load()

Set db = New ADODB.Connection

db.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0;Data Source=" & App.Path & "\Data.mdb"

Set rskasir = New ADODB.Recordset

rskasir.Open "SELECT * FROM kasir Order By kodekasir", db, 3, 2

Set rsbarang = New ADODB.Recordset

rsbarang.Open "SELECT * FROM barang Order By kodebarang", db, 3, 2

If rskasir.RecordCount <> 0 Then

rskasir.MoveFirst

For i = 1 To rskasir.RecordCount

    cmbkdkasir.AddItem rskasir.Fields(0)

    rskasir.MoveNext

Next i

End If

If rsbarang.RecordCount <> 0 Then

rsbarang.MoveFirst

For i = 1 To rsbarang.RecordCount

    cmbkdbarang.AddItem rsbarang.Fields(0)

    rsbarang.MoveNext

Next i

End If

End Sub

Private Sub txtjmlbayar_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   If txtjumlah = "" Then

      txtjumlah.SetFocus

     Else

txtkembali = txtjmlbayar - txtTotal2

End If

End If

End Sub

Private Sub txtjumlah_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   If txtjumlah = "" Then

      txtjumlah.SetFocus

     Else

      If IsNumeric(txtjumlah) = True Then

         'SIMPAN DETAIL PENJUALAN

         txtsubtotal = Val(txtharga) * Val(txtjumlah)

         db.Execute "INSERT INTO Buffer values('" & txtnofaktur & "','" & _

                    cmbkdbarang & "', '" & txtnamabarang & "', '" & txtharga & _

                    "', '" & txtjumlah & "', '" & txtsubtotal & "') "

                

         lstKdBrg.AddItem cmbkdbarang

         lstNmBrg.AddItem txtnamabarang

         lstHrg.AddItem txtharga

         lstjumlah.AddItem txtjumlah

         lstSubTotal.AddItem txtsubtotal

         txtTotalJumlah = Val(txtTotalJumlah) + Val(txtjumlah)

         txtTotal = Val(txtTotal) + Val(txtsubtotal)

         txttotalbayar = Val(txttotalbayar) + Val(txtsubtotal)

         txtTotal2 = txtTotal

         cmbkdbarang.SetFocus

        Else

         txtjumlah.SetFocus

      End If

    End If

End If

End Sub

FORM SPLASH

 

Private Sub tmrSplash_Timer()

Load MDIForm1

Unload Me

MDIForm1.Show

End Sub

MDI FORM

 

Private Sub dfdf_Click()

Unload Me

End Sub

Private Sub dgg_Click()

frmKasir.Show

End Sub

Private Sub dgksgdkj_Click()

Unload Me

End Sub

Private Sub fgg_Click()

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.ReportFileName = App.Path & "\penjualan.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub gg_Click()

frmPemasok.Show

End Sub

Private Sub hh_Click()

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.ReportFileName = App.Path & "\kasir.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub hj_Click()

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.ReportFileName = App.Path & "\pemasok.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub ii_Click()

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.ReportFileName = App.Path & "\barang.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub lk_Click()

frmPenjualan.Show

End Sub

Private Sub lol_Click()

frmadminuserr.Show

frmadminuserr.cmdsetuser.Enabled = False

End Sub

Private Sub nn_Click()

ShellAbout 0, "PT Maju Ra Iso Mundur Ra Iso", "Penggajian Manajemen System V1.0" & vbCrLf & _

              "by : Satriadholan", Icon

End Sub

Private Sub sfsf_Click()

Frmbarang.Show

End Sub

Private Sub MDIForm_Load()

On Error GoTo errs

'Call HookToolTips

Dim MyDay, tDay

FORMAktif = ""

MyDay = Array("Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu")

tDay = MyDay(Abs(Weekday(Date) - 1))

Label1 = tDay & " , " & Format(Date, "DD-MM-YYYY") & " / " & Format(Time, "HH:MM:SS")

Label2 = "Toko Serba Ada Mandiri, Alamat Jl. Raya Papua Timur No 258 Telp (0230009) Papua Toko Serba Ada Mandiri, Alamat Jl. Raya Papua Timur No 258 Telp (0230009) Papua  Toko Serba Ada Mandiri, Alamat Jl. Raya Papua Timur No 258 Telp (0230009) Papua"

Exit Sub

errs:

   MsgBox Err.Description

End Sub

Private Sub sfsfj_Click()

frmlap.Show

End Sub

Private Sub Timer1_Timer()

Dim MyDay, tDay

MyDay = Array("Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu")

tDay = MyDay(Abs(Weekday(Date) - 1))

Label1 = tDay & " , " & Format(Date, "DD-MM-YYYY") & " / " & Format(Time, "HH:MM:SS")

End Sub

Private Sub Timer2_Timer()

Label2 = Mid(Label2, 2, Len(Label2) - 1) & Left(Label2, 1)

End Sub

MODULE

Public Declare Function ShellAbout Lib "shell32.dll" Alias _

    "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, _

    ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Public Sub Bersih(frm As Form)

For Each obj In frm

   If TypeOf obj Is TextBox Then

      obj.Text = ""

     ElseIf TypeOf obj Is ComboBox Then

      obj.Text = ""

     ElseIf TypeOf obj Is OptionButton Then

      obj.Value = False

     ElseIf TypeOf obj Is ListBox Then

      obj.Clear

        

   End If

Next obj

End Sub

CARA MEMBUAT FILE .EXE

1. BUKA FILE VB NYA
2. PASTIKAN CODING TIDAK ADA YANG DEBUG
3. PILIH FILE
4. PILIH MAKE PENGGAJIAN.EXE/PROJECT.EXE
5. ARAHKAN MAU DISIMPAN DIMAN, LALU KLIK OKE.

URUTAN SET FORM :

1. SPLASH
2. LOGGIN
3. MDI FORM
4. JABATAN
5. PEGAWAI
6. PENGGAJIAN

CARA MERUBAH START UP :

1. KLIK KANAN DI PROJECT
2. PILIH PROJECT PRIPERTIES
3. PILIH STAR UP OBJECT LALU PILIH FORM YANG AKAN BERJALAN PERTAMA KALI DIJALANKAN.
4. KLIK OKE

  

CODING :

Dim a, b, c, d, e, f

Private Sub cmdBatal_Click()

Unload Me

End Sub

Private Sub cmdLaporan_Click()

a = Format(txtTgl1.Text, "yyyy")

b = Format(txtTgl2.Text, "yyyy")

c = Format(txtTgl1.Text, "m")

d = Format(txtTgl2.Text, "m")

e = Format(txtTgl1.Text, "d")

f = Format(txtTgl2.Text, "d")

Crpt.DataFiles(0) = App.Path & "\Data.mdb"

Crpt.SelectionFormula = "{HPenjualan.Tgl}in Date (" & a & "," & c & "," & e & ") to Date (" & b & "," & d & "," & f & ")"

Crpt.ReportFileName = App.Path & "\pjl.rpt"

Crpt.Destination = crptToWindow

Crpt.WindowState = crptMaximized

Crpt.Action = 1

End Sub

Private Sub Form_Load()

Height = 3810

Width = 5400

Left = 0

Top = 0

Me.Icon = MDIForm1.Icon

txtTgl1.Mask = "##-##-####"

txtTgl2.Mask = "##-##-####"

End Sub

Private Sub txtTgl1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   If Not IsDate(txtTgl1.Text) Then

      MsgBox "data tidak Valid"

      'txtTgl1.Text = ""

      txtTgl1.SetFocus

     Else

      txtTgl2.SetFocus

   End If

End If

End Sub

Private Sub txtTgl2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

   If Not IsDate(txtTgl2.Text) Then

      MsgBox "data tidak Valid"

'      txtTgl2 = ""

      txtTgl2.SetFocus

     Else

      cmdLaporan.SetFocus

   End If

End If

End Sub