Modul
Public status As IntegerPublic Conn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public StrConnect As String
Public StrSQL As String
Public Sub Konek()
StrConnect = "Provider=Microsoft.Jet.OleDB.4.0;Data Source=" + App.Path + "\penjualan.mdb"
If Conn.State = adStateOpen Then
Conn.Close
Set Conn = New ADODB.Connection
Conn.Open StrConnect
Else
Conn.Open StrConnect
End If
End Sub
Script
Private Sub cmdcari_Click()
'If txtkodecus.Text = "" Then
'MsgBox "Ketik dulu kode yang akan dicari!", vbInformation + vbOKOnly, "Informasi"
'Else
StrSQL = "SELECT * FROM customer WHERE kode_cus ='" & txtcari.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Rs.EOF Then
MsgBox "Nama dengan kode """ + ftxtkodecus.Text + """ Tidak Ada", vbExclamation + vbOKOnly, "Informasi"
Else
txtkodecus.Text = "" + Rs("kode_cus")
txtnamacus.Text = "" + Rs("nama_cus")
txtalamatcus.Text = "" + Rs("alamat_cus")
End If
'End If
cmdhapus.Enabled = True
cmdedit.Enabled = True
End Sub
Private Sub cmdedit_Click()
'cmdsimpan.Enabled = True
cmdupdate.Enabled = True
txtkodecus.Enabled = True
txtnamacus.Enabled = True
txtalamatcus.Enabled = True
End Sub
Private Sub cmdhapus_Click()
Dim Pesan As Integer
Pesan = MsgBox("Apakah anda yakin ingin mnghapus?", vbQuestion + vbYesNo, "Konfirmasi")
If Pesan = 6 Then
StrSQL = "DELETE FROM customer WHERE kode_cus ='" & txtcari.Text & "'"
Conn.Execute (StrSQL)
txtkodecus.Text = ""
txtnamacus.Text = ""
txtalamatcus.Text = ""
End If
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub
Private Sub cmdsimpan_Click()
If txtkodecus.Text = "" Then
MsgBox "kode belum diisi, Gaboleh kosong!!!", vbExclamation + vbOKOnly, "PERINGATAN"
txtkodecus.SetFocus
Else
StrSQL = "INSERT INTO customer(kode_cus, nama_cus, alamat_cus)VALUES ('" & txtkodecus.Text & "','" & txtnamacus.Text & "','" & txtalamatcus.Text & "')"
Conn.Execute (StrSQL)
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
cmdsimpan.Enabled = False
End If
End Sub
Private Sub cmdtambah_Click()
txtkodecus.Enabled = True
txtnamacus.Enabled = True
txtalamatcus.Enabled = True
txtkodecus.Text = ""
txtnamacus.Text = ""
txtalamatcus.Text = ""
txtkodecus.SetFocus
cmdsimpan.Enabled = True
End Sub
Private Sub cmdupdate_Click()
StrSQL = "SELECT kode_cus FROM customer WHERE kode_cus ='" & txtkodecus.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If (txtkodecus.Text <> txtkodecus.Text) And (Not Rs.EOF) Then
MsgBox "customer dengan kodecus" + txtkodecus.Text + "sudah ada!", vbInformation + vbOKOnly, "Informasi"
txtNis.SetFocus
Else
StrSQL = "UPDATE customer SET kode_cus='" & txtkodecus.Text & "',nama_cus='" & txtnamacus.Text & _
"',alamat_cus='" & txtalamatcus.Text & "' WHERE kode_cus='" & txtkodecus.Text & "'"
Conn.Execute (StrSQL)
End If
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
cmdedit.Enabled = False
cmdupdate.Enabled = False
MsgBox " kode customer dengan kode tersebut sudah di update"
txtkodecus.Text = ""
txtnamacus.Text = ""
txtalamatcus.Text = ""
txtcari.Text = ""
txtkodecus.Enabled = False
txtnamacus.Enabled = False
txtalamatcus.Enabled = False
End Sub
Private Sub Command1_Click()
'cmdedit.Enabled = True
'cmdhapus.Enabled = True
'Cari = txtcari.Text + "%"
'StrSQL = "SELECT * FROM customer WHERE kode_cus like '" & Cari & "'"
'Adodc1.RecordSource = StrSQL
'Adodc1.Refresh
'End Sub
Private Sub Command2_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Form_Load()
cmdsimpan.Enabled = False
cmdedit.Enabled = False
cmdupdate.Enabled = False
cmdhapus.Enabled = False
txtkodecus.Enabled = False
txtnamacus.Enabled = False
txtalamatcus.Enabled = False
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub
(menu)
Private Sub mnuCus_Click()
Me.Hide
Form1.Show
End Sub
Private Sub mnuKeluar_Click()
Unload Me
End Sub
Private Sub mnuLaporan_Click()
If status = 0 Then
Me.Hide
frmlaporan.Show
frmlaporan.cmdcetak.Enabled = False
frmlaporan.Command1.Enabled = False
Else
Me.Hide
frmlaporan.Show
frmlaporan.cmdcetak.Enabled = True
frmlaporan.Command1.Enabled = True
End If
End Sub
Private Sub mnuTrans_Click()
Me.Hide
Form2.Show
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Me.Hide
Select Case Button.Index
Case 1
Form1.Show
Case 2
Form2.Show
Case 3
frmlaporan.Show
End Select
End Sub
(login)
Private Sub cmdbtl_Click()
Unload Me
frmregister.Show
End Sub
Private Sub cmdok_Click()
If txtuser.Text = "" Then
MsgBox "Username belum diisi'", vbExclamation + vbOKOnly, "Peringatan"
txtuser.SetFocus
ElseIf txtpass.Text = "" Then
MsgBox "Password belum diisi '", vbExclamation + vbOKOnly, "Peringatan"
txtpass.SetFocus
Else
Call Konek
StrSQL = "SELECT * FROM Login WHERE pengguna = '" & txtuser.Text & "' AND sandi = '" & txtpass.Text & "' AND hakakses = '" & Combo1.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Rs.EOF Then
MsgBox "Username atau Password atau hak akses yang dimasukkan salah!", vbInformation + vbOKOnly, "Informasi"
Else
If Combo1.Text = "administrator" Then
status = 1
Unload Me
frmmenu.Show
MsgBox "Anda login sebagai administrator ", vbInformation + vbOKOnly, "Informasi"
Else
status = 0
Unload Me
frmmenu.Show
MsgBox " Anda login sebagai User", vbInformation + vbOKOnly, "Informasi"
frmmenu.mnuFile.Enabled = False
frmlaporan.Command1.Enabled = False
frmlaporan.Command2.Enabled = False
frmlaporan.cmdcetak1.Enabled = False
frmlaporan.cmdcetak.Enabled = False
End If
End If
End If
End Sub
Private Sub Label5_Click()
Unload Me
frmregister.Show
End Sub
(login cancel)
Private Sub cmdbtl_Click()
Unload Me
frmregister.Show
End Sub
Private Sub cmdok_Click()
If txtuser.Text = "" Then
MsgBox "Username belum diisi'", vbExclamation + vbOKOnly, "Peringatan"
txtuser.SetFocus
ElseIf txtpass.Text = "" Then
MsgBox "Password belum diisi '", vbExclamation + vbOKOnly, "Peringatan"
txtpass.SetFocus
Else
Call Konek
StrSQL = "SELECT * FROM Login WHERE pengguna = '" & txtuser.Text & "' AND sandi = '" & txtpass.Text & "' AND hakakses = '" & Combo1.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Rs.EOF Then
MsgBox "Username atau Password atau hak akses yang dimasukkan salah!", vbInformation + vbOKOnly, "Informasi"
Else
If Combo1.Text = "administrator" Then
status = 1
Unload Me
frmmenu.Show
MsgBox "Anda login sebagai administrator ", vbInformation + vbOKOnly, "Informasi"
Else
status = 0
Unload Me
frmmenu.Show
MsgBox " Anda login sebagai User", vbInformation + vbOKOnly, "Informasi"
frmmenu.mnuFile.Enabled = False
frmlaporan.Command1.Enabled = False
frmlaporan.Command2.Enabled = False
frmlaporan.cmdcetak1.Enabled = False
frmlaporan.cmdcetak.Enabled = False
End If
End If
End If
End Sub
Private Sub Label5_Click()
Unload Me
frmregister.Show
End Sub
(cetak laporan)
Dim MsExcel As Excel.Application
Private Sub cmdcetak_Click()
Set DataReport2.DataSource = Adodc2
DataReport2.Refresh
DataReport2.WindowState = 2
DataReport2.Show
Adodc2.Refresh
End Sub
Private Sub cmdcetak1_Click()
Set DataReport1.DataSource = Adodc1
DataReport1.Refresh
DataReport1.WindowState = 2
DataReport1.Show
Adodc1.Refresh
End Sub
Private Sub Command1_Click()
MsExcel.Workbooks.Add
MsExcel.Range("A1").Value = "Kode Customer"
MsExcel.Range("B1").Value = "Nama Customer"
MsExcel.Range("C1").Value = "Alamat Customer"
i = 1
Do While Not Adodc1.Recordset.EOF
MsExcel.Range("A" & i + 1).Value = Adodc1.Recordset("Kode_cus")
MsExcel.Range("B" & i + 1).Value = Adodc1.Recordset("Nama_cus")
MsExcel.Range("C" & i + 1).Value = Adodc1.Recordset("Alamat_cus")
i = i + 1
Adodc1.Recordset.MoveNext
Loop
MsExcel.Visible = True
End Sub
Private Sub Command2_Click()
MsExcel.Workbooks.Add
MsExcel.Range("A1").Value = "Nomor Nota"
MsExcel.Range("B1").Value = "Tanggal Nota"
MsExcel.Range("C1").Value = "Kode Customer"
i = 1
Do While Not Adodc1.Recordset.EOF
MsExcel.Range("A" & i + 1).Value = Adodc2.Recordset("No_nota")
MsExcel.Range("B" & i + 1).Value = Adodc2.Recordset("Tanggal_nota")
MsExcel.Range("C" & i + 1).Value = Adodc2.Recordset("Kode_cus")
i = i + 1
Adodc1.Recordset.MoveNext
Loop
MsExcel.Visible = True
End Sub
Private Sub Command3_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Command4_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Form_Load()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
Adodc2.ConnectionString = StrConnect
Adodc2.RecordSource = "SELECT * FROM transaksi"
Adodc2.Refresh
Set DataGrid2.DataSource = Adodc2
Combo1.AddItem "Kode_cus"
Combo1.AddItem "Nama_cus"
Combo1.AddItem "Alamat_cus"
Combo2.AddItem "No_nota"
Combo2.AddItem "Tanggal_nota"
Combo2.AddItem "Kode_cus"
Set MsExcel = CreateObject("Excel.Application")
End Sub
Private Sub Text1_Change()
cari = Text1.Text + "%"
StrSQL = "SELECT * FROM Customer WHERE " + Combo1.Text + " LIKE '" & cari & "'"
Adodc1.RecordSource = StrSQL
Adodc1.Refresh
End Sub
Private Sub Text2_Change()
cari = Text2.Text + "%"
StrSQL = "SELECT * FROM Transaksi WHERE " + Combo2.Text + " LIKE '" & cari & "'"
Adodc2.RecordSource = StrSQL
Adodc2.Refresh
End Sub
Dim MsExcel As Excel.Application
Private Sub cmdcetak_Click()
Set DataReport2.DataSource = Adodc2
DataReport2.Refresh
DataReport2.WindowState = 2
DataReport2.Show
Adodc2.Refresh
End Sub
Private Sub cmdcetak1_Click()
Set DataReport1.DataSource = Adodc1
DataReport1.Refresh
DataReport1.WindowState = 2
DataReport1.Show
Adodc1.Refresh
End Sub
Private Sub Command1_Click()
MsExcel.Workbooks.Add
MsExcel.Range("A1").Value = "Kode Customer"
MsExcel.Range("B1").Value = "Nama Customer"
MsExcel.Range("C1").Value = "Alamat Customer"
i = 1
Do While Not Adodc1.Recordset.EOF
MsExcel.Range("A" & i + 1).Value = Adodc1.Recordset("Kode_cus")
MsExcel.Range("B" & i + 1).Value = Adodc1.Recordset("Nama_cus")
MsExcel.Range("C" & i + 1).Value = Adodc1.Recordset("Alamat_cus")
i = i + 1
Adodc1.Recordset.MoveNext
Loop
MsExcel.Visible = True
End Sub
Private Sub Command2_Click()
MsExcel.Workbooks.Add
MsExcel.Range("A1").Value = "Nomor Nota"
MsExcel.Range("B1").Value = "Tanggal Nota"
MsExcel.Range("C1").Value = "Kode Customer"
i = 1
Do While Not Adodc1.Recordset.EOF
MsExcel.Range("A" & i + 1).Value = Adodc2.Recordset("No_nota")
MsExcel.Range("B" & i + 1).Value = Adodc2.Recordset("Tanggal_nota")
MsExcel.Range("C" & i + 1).Value = Adodc2.Recordset("Kode_cus")
i = i + 1
Adodc1.Recordset.MoveNext
Loop
MsExcel.Visible = True
End Sub
Private Sub Command3_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Command4_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Form_Load()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM customer"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
Adodc2.ConnectionString = StrConnect
Adodc2.RecordSource = "SELECT * FROM transaksi"
Adodc2.Refresh
Set DataGrid2.DataSource = Adodc2
Combo1.AddItem "Kode_cus"
Combo1.AddItem "Nama_cus"
Combo1.AddItem "Alamat_cus"
Combo2.AddItem "No_nota"
Combo2.AddItem "Tanggal_nota"
Combo2.AddItem "Kode_cus"
Set MsExcel = CreateObject("Excel.Application")
End Sub
Private Sub Text1_Change()
cari = Text1.Text + "%"
StrSQL = "SELECT * FROM Customer WHERE " + Combo1.Text + " LIKE '" & cari & "'"
Adodc1.RecordSource = StrSQL
Adodc1.Refresh
End Sub
Private Sub Text2_Change()
cari = Text2.Text + "%"
StrSQL = "SELECT * FROM Transaksi WHERE " + Combo2.Text + " LIKE '" & cari & "'"
Adodc2.RecordSource = StrSQL
Adodc2.Refresh
End Sub
(register)
Private Sub cmdbtl_Click()
Unload Me
frmlogin.Show
End Sub
Private Sub cmddaftar_Click()
If txtuser.Text = "" Then
MsgBox "Username Harus Di isi terlebih dahulu", vbExclamation + vbOKOnly, "Peringatan"
ElseIf txtpass.Text = "" Then
MsgBox "Password Harus Di isi terlebih dahulu", vbExclamation + vbOKOnly, "Peringatan"
Else
Call Konek
StrSQL = "SELECT Pengguna FROM Login WHERE Pengguna='" & txtuser.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Not Rs.EOF Then
MsgBox "Maaf Username yang anda Masukkan sudah dipakai, ganti yang lain", vbExclamation + vbOKOnly, "Peringatan"
Else
StrSQL = "INSERT INTO Login VALUES('" & txtuser.Text & "','" & txtpass.Text & "','" & Combo1.Text & "')"
Conn.Execute (StrSQL)
MsgBox "Username baru telah ditambahkan", vbExclamation + vbOKOnly, "Peringatan"
End If
End If
Unload Me
frmlogin.Show
End Sub
Private Sub Form_Load()
Combo1.Text = "user"
Combo1.Enabled = False
End Sub
(btl register)
Private Sub cmdbtl_Click()
Unload Me
frmlogin.Show
End Sub
Private Sub cmddaftar_Click()
If txtuser.Text = "" Then
MsgBox "Username Harus Di isi terlebih dahulu", vbExclamation + vbOKOnly, "Peringatan"
ElseIf txtpass.Text = "" Then
MsgBox "Password Harus Di isi terlebih dahulu", vbExclamation + vbOKOnly, "Peringatan"
Else
Call Konek
StrSQL = "SELECT Pengguna FROM Login WHERE Pengguna='" & txtuser.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Not Rs.EOF Then
MsgBox "Maaf Username yang anda Masukkan sudah dipakai, ganti yang lain", vbExclamation + vbOKOnly, "Peringatan"
Else
StrSQL = "INSERT INTO Login VALUES('" & txtuser.Text & "','" & txtpass.Text & "','" & Combo1.Text & "')"
Conn.Execute (StrSQL)
MsgBox "Username baru telah ditambahkan", vbExclamation + vbOKOnly, "Peringatan"
End If
End If
Unload Me
frmlogin.Show
End Sub
Private Sub Form_Load()
Combo1.Text = "user"
Combo1.Enabled = False
End Sub
Tidak ada komentar:
Posting Komentar