Sabtu, 24 Januari 2015

script visual basic

"MODUL"-koneksi database
Public Conn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public StrConnect As String
Public StrSQL As String
Public loginAs As String

Public Sub Konek()
StrConnect = "Provider=Microsoft.Jet.OleDB.4.0;Data Source=" + App.Path + "\DB_KASIR.mdb;Jet OleDB:Database Password=supadi"
If Conn.State = adStateOpen Then
Conn.Close
Set Conn = New ADODB.Connection
Conn.Open StrConnect
Else
Conn.Open StrConnect
End If
End Sub

"LOGIN"
Private Sub cmdcancel_Click()
Unload Me
End Sub

Private Sub cmdLogin_Click()
If txtUser.Text = "" Then
pesan = MsgBox("user name belum diisi!", vbExclamation + vbOKOnly, "peringatan")
txtUser.SetFocus

ElseIf txtPassword.Text = "" Then
pesan = MsgBox("password belum diisi!", vbExclamation + vbOKOnly, "peringatan")
txtPassword.SetFocus
Else
Call Konek
StrSQL = "SELECT * FROM Login WHERE Username='" & txtUser.Text & "' AND Password='" & txtPassword.Text & "' AND Hak_akses='" & Combo3.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Rs.EOF Then
pesan = MsgBox("user atau password atau hak akses salah!", vbInformation + vbOKOnly, "informasi")
Else
If Combo3.Text = "administrator" Then
Module1.loginAs = "administrator"
Unload Me
frmTampilan.Show
MsgBox "anda login sebagai administrator!", vbInformation + vbOKOnly, "informasi"
Else
Module1.loginAs = "user"
'Unload Me
Me.Hide
frmTampilan.Show
MsgBox "anda login sebagai user!", vbInformation + vbOKOnly, "informasi"
frmMenuUser.mnuFile.Enabled = False
End If
End If
End If
End Sub

Private Sub Form_Load()
Combo3.AddItem "user"
Combo3.AddItem "administrator"
End Sub



"CRUTD"-fungsi
Sub RefreshTampilan()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
'lblJumlahBarang.Caption = "Jumlah Data : " & Adodc1.Recordset.RecordCount
Set DataGrid1.DataSource = Adodc1
End Sub
Private Sub cmdCari_Click()
If txtCari.Text = "" Then
MsgBox "Ketik Dulu Kode Barang Yang Akan dicari !", vbInformation + vbOKOnly, "informasi"
Else
StrSQL = "SELECT * FROM Barang WHERE Kode_Barang='" & txtCari.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Rs.EOF Then
MsgBox "Kode Barang Dengan """ + txtKdBarang.Text & """ Tidak Ada", vbExclamation + vbOKOnly, "warning"
Else
txtKdBarang.Text = "" + Rs("Kode_Barang")
txtNamaBarang.Text = "" + Rs("Nama_Barang")
txtHargaBarang.Text = Rs("Harga_Barang")
Combo1.Text = "" + Rs("Id_Kategori")
End If
End If
cmdHapus.Enabled = True
cmdEdit.Enabled = True
End Sub

Private Sub cmdEdit_Click()
cmdUpdate.Enabled = True
txtKdBarang.Enabled = True
txtNamaBarang.Enabled = True
txtHargaBarang.Enabled = True
Combo1.Enabled = True
End Sub

Private Sub cmdHapus_Click()
Dim pesan As Integer
pesan = MsgBox("Apakah anda Yakin ingin Menghapus ?", vbQuestion + vbYesNo, "Confirmation")
If pesan = 6 Then
StrSQL = "DELETE FROM Barang WHERE Kode_Barang ='" & txtCari.Text & "'"
Conn.Execute (StrSQL)
txtCari.Text = ""

txtKdBarang.Text = ""
txtNamaBarang.Text = ""
txtHargaBarang.Text = ""
Combo1.Text = ""
End If
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub cmdSimpan_Click()
If txtKdBarang.Text = "" Then
MsgBox "Kode Barang belum diisi, Tidak boleh kosong!!!", vbExclamation + vbOKOnly, "ATTENTION"
Else
StrSQL = "SELECT Kode_Barang FROM Barang WHERE Kode_Barang='" & txtKdBarang.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If Not Rs.EOF Then
MsgBox "Kode Barang tersebut sudah ada,Tidak boleh  sama!!!!", vbInformation + vbOKOnly, "Information"
txtKdBarang.SetFocus
Else
StrSQL = "INSERT INTO Barang(Kode_Barang, Nama_Barang, Harga_Barang, Id_Kategori)VALUES ('" & txtKdBarang.Text & "','" & txtNamaBarang.Text & "','" & txtHargaBarang.Text & "','" & Combo1.Text & "')"
Conn.Execute (StrSQL)
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End If
cmdSimpan.Enabled = False
End If
End Sub

Private Sub cmdTambah_Click()
txtKdBarang.Text = ""
txtNamaBarang.Text = ""
txtHargaBarang.Text = ""
Combo1.Text = ""

txtKdBarang.Enabled = True
txtNamaBarang.Enabled = True
txtHargaBarang.Enabled = True
Combo1.Enabled = True
cmdSimpan.Enabled = True
txtKdBarang.SetFocus
End Sub

Private Sub cmdTutup_Click()
If Module1.loginAs = "user" Then
Unload Me
frmMenuUser.Show
Else
Unload Me
frmMenuAdmin.Show
End If
End Sub

Private Sub cmdUpdate_Click()
StrSQL = "SELECT Kode_Barang FROM Barang WHERE Kode_Barang ='" & txtCari.Text & "'"
Set Rs = Conn.Execute(StrSQL)
If (txtKdBarang.Text <> txtCari.Text) And (Not Rs.EOF) Then

MsgBox "Barang dengan Kode Barang" + txtKdBarang.Text + "Sudah Ada !", vbInformation + vbOKOnly, " Data sudah ada"
txtKdBarang.SetFocus
Else
StrSQL = "UPDATE Barang SET Kode_Barang ='" & txtKdBarang.Text & "',Nama_Barang='" & txtNamaBarang.Text & "',Harga_Barang='" & txtHargaBarang.Text & "',Id_Kategori='" & Combo1.Text & "' WHERE Kode_Barang= '" & txtKdBarang & "'"
Conn.Execute (StrSQL)
End If
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
cmdEdit.Enabled = False
cmdUpdate.Enabled = False
MsgBox "Data Barang Dengan Kode Barang tersebut sudah diupdate"
End Sub

Private Sub Combo1_Change()
StrSQL = "SELECT * FROM Kategori WHERE Id_Kategori ='" & Combo1.Text & "'"
Set Rs = Conn.Execute(StrSQL)
End Sub

"Private Sub Form_Load()"
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
StrSQL = "SELECT Id_Kategori from Kategori"
Set Rs = Conn.Execute(StrSQL)
Combo1.Clear
Do While Not Rs.EOF
Combo1.AddItem Rs("Id_Kategori")
Rs.MoveNext
Loop

Call TxtKeadaan(False)
Call RefreshTampilan
cmdEdit.Enabled = False
cmdHapus.Enabled = False
cmdSimpan.Enabled = False
cmdUpdate.Enabled = False

txtKdBarang.Enabled = False
txtNamaBarang.Enabled = False
txtHargaBarang.Enabled = False
Combo1.Enabled = False

cmdHapus.Enabled = False
cmdEdit.Enabled = False
cmdUpdate.Enabled = False
cmdSimpan.Enabled = False
cmdTambah.Enabled = True

cmdUpdate.Enabled = False
If frmLogin.Combo3.Text = "user" Then
cmdEdit.Enabled = False
cmdUpdate.Enabled = False
cmdHapus.Enabled = False
cmdCari.Enabled = False
End If
End Sub

Private Sub Timer1_Timer()
lbltanggal.Caption = Format(Now, "dddd, dd-mm-yyyy")
End Sub

"Sub TxtKeadaan(stat As Boolean)"
txtKdBarang.Enabled = stat
txtNamaBarang.Enabled = stat
txtHargaBarang.Enabled = stat
Combo1.Enabled = stat
End Sub

"DATA REPORT + CONVERT TO EXCEL"
Dim MsExcel As Excel.Application
Private Sub cmdcetak1_Click()
Set DataReport1.DataSource = Adodc1
DataReport1.Refresh
DataReport1.WindowState = 2
DataReport1.Show
Adodc1.Refresh
End Sub

Private Sub cmdExit1_Click()
If Module1.loginAs = "user" Then
Unload Me
frmMenuUser.Show
Else
Unload Me
frmMenuAdmin.Show
End If
End Sub

Private Sub cmdExcel1_Click()
MsExcel.Workbooks.Add
MsExcel.Range("A1").Value = "Kode Barang"
MsExcel.Range("B1").Value = "Nama Barang"
MsExcel.Range("C1").Value = "Harga Barang"
MsExcel.Range("D1").Value = "Id Kategori"

i = 1
Do While Not Adodc1.Recordset.EOF
MsExcel.Range("A" & i + 1).Value = Adodc1.Recordset("Kode_Barang")
MsExcel.Range("B" & i + 1).Value = Adodc1.Recordset("Nama_Barang")
MsExcel.Range("C" & i + 1).Value = Adodc1.Recordset("Harga_Barang")
MsExcel.Range("D" & i + 1).Value = Adodc1.Recordset("Id_Kategori")

i = i + 1
Adodc1.Recordset.MoveNext
Loop
MsExcel.Visible = True
End Sub

Private Sub Form_Load()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "SELECT * FROM Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1

Combo1.AddItem "Kode_Barang"
Combo1.AddItem "Nama_Barang"
Combo1.AddItem "Harga_Barang"
Combo1.AddItem "Id_Kategori"
If frmLogin.Combo3.Text = "user" Then
frmLaporan.cmdExcel1.Enabled = False
frmLaporan.cmdcetak1.Enabled = False
End If
Set MsExcel = CreateObject("Excel.Application")
End Sub

Private Sub Text1_Change()
cari = Text1.Text + "%"
StrSQL = "SELECT * FROM Barang WHERE " + Combo1.Text + " LIKE '" & cari & "'"
Adodc1.RecordSource = StrSQL
Adodc1.Refresh

End Sub



Tidak ada komentar:

Posting Komentar