Klik - Download nu ieu
Sub mulai()
'Tampilan Awal
Me.Rkasir.RecordSource = "select * from kasir"
Me.Rkasir.Refresh
Me.Caption = jdl.Caption
depan
bersih
mati
tfilter.SetFocus
End Sub
Sub isicombo()
'Mengisi Field Data Kurir
On Error GoTo pusing
With Rkasir
.RecordSource = "select * from kasir"
For i = 0 To .Recordset.Fields.Count - 1
Me.cbfilter.AddItem .Recordset.Fields(i).Name
Next
End With
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Sub bersih()
tkode.Text = ""
tnama.Text = ""
tpass.Text = ""
cblevel.Text = ""
End Sub
Sub hidup()
tkode.Enabled = 1
tnama.Enabled = 1
tpass.Enabled = 1
cblevel.Enabled = 1
End Sub
Sub mati()
tkode.Enabled = 0
tnama.Enabled = 0
tpass.Enabled = 0
cblevel.Enabled = 0
End Sub
Sub depan()
Data1.Visible = 1
Data2.Visible = 0
End Sub
Sub belakang()
Data1.Visible = 0
Data2.Visible = 1
End Sub
Sub simpan()
'menyimpan data ke Tabel
With Me.Rkasir.Recordset
!kode_kasir = UCase(Me.tkode.Text)
!nama_kasir = Me.tnama.Text
!Password = Me.tpass.Text
!Level = Me.cblevel.Text
End With
End Sub
Sub tampil()
On Error Resume Next
'menampilkan Isi Tabel Ke Form
With Me.Rkasir.Recordset
Me.tkode.Text = !kode_kasir
Me.tnama.Text = !nama_kasir
Me.tpass.Text = !Password
Me.cblevel.Text = !Level
End With
End Sub
Private Sub cbatal_Click()
mulai
End Sub
Private Sub cblevel_Click()
csimpan.SetFocus
End Sub
Private Sub ccari_Click()
On Error GoTo pusing
With Rkasir
.RecordSource = "select * from kasir where " & cbfilter.Text & " like '%" & tfilter.Text & "%' "
.Refresh
'Jika data yang dicari tidak ada
If .Recordset.EOF Then
MsgBox "Data Tidak ada", vbOKOnly, "Cari"
Else
belakang
hidup
tampil
End If
End With
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub chapus_Click()
On Error GoTo pusing
Dim cari As String
cari = UCase(Trim(tkode.Text))
'Jika teks ga diisi
If tkode.Text = "" Or tnama.Text = "" Or tpass.Text = "" Or cblevel.Text = "" Then
MsgBox "Anda harus isi semua data", vbOKOnly, "Salah"
mulai
belakang
hidup
tkode.SetFocus
Else
With Rkasir
.RecordSource = "select * from kasir where kode_kasir= '" & cari & "'"
.Refresh
'Jika Kode Kasir sudah ada
If .Recordset.EOF Then
MsgBox "Kode Kasir Tidak Ada", vbOKOnly, "Salah"
tkode.Text = ""
tkode.SetFocus
Else
'Proses Penghapusan
.Recordset.Delete
Me.tfilter.Text = ""
MsgBox "Data Kasir Berhasil Dihapus", vbOKOnly, "Sukses"
mulai
End If
End With
End If
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub ckeluar_Click()
Unload Me
End Sub
Private Sub csimpan_Click()
On Error GoTo pusing
Dim cari As String
cari = UCase(Trim(tkode.Text))
'Jika teks ga diisi
If tkode.Text = "" Or tnama.Text = "" Or tpass.Text = "" Or cblevel.Text = "" Then
MsgBox "Anda harus isi semua data", vbOKOnly, "Salah"
mulai
belakang
hidup
tkode.SetFocus
Else
With Rkasir
.RecordSource = "select * from kasir where kode_kasir= '" & cari & "'"
.Refresh
'Jika Kode Kasir sudah ada
If Not .Recordset.EOF Then
MsgBox "Kode Kasir Sudah Ada", vbOKOnly, "Salah"
tkode.Text = ""
tkode.SetFocus
Else
'Proses Penyimpanan
.Recordset.AddNew
simpan
.Recordset.Update
MsgBox "Data Kasir Tersimpan", vbOKOnly, "Sukses"
mulai
End If
End With
End If
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub ctambah_Click()
belakang
hidup
bersih
tkode.SetFocus
End Sub
Private Sub cubah_Click()
On Error GoTo pusing
Dim cari As String
cari = UCase(Trim(tkode.Text))
'Jika teks ga diisi
If tkode.Text = "" Or tnama.Text = "" Or tpass.Text = "" Or cblevel.Text = "" Then
MsgBox "Anda harus isi semua data", vbOKOnly, "Salah"
mulai
belakang
hidup
tkode.SetFocus
Else
With Rkasir
.RecordSource = "select * from kasir where kode_kasir= '" & cari & "'"
.Refresh
'Proses Update data
simpan
.Recordset.Update
MsgBox "Data Kasir Berhasil Di Update", vbOKOnly, "Sukses"
mulai
End With
End If
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub DataGrid1_DblClick()
On Error GoTo pusing
With Rkasir
.RecordSource = "select * from kasir where kode_kasir = '" & DataGrid1.Text & "' "
.Refresh
'Jika data yang dicari tidak ada
If .Recordset.EOF Then
MsgBox "Data Tidak ada", vbOKOnly, "Cari"
Else
belakang
hidup
tampil
End If
End With
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub Form_Activate()
mulai
End Sub
Private Sub Form_Load()
cblevel.AddItem "User"
cblevel.AddItem "Admin"
isicombo
End Sub
Private Sub tfilter_Change()
On Error GoTo pusing
With Rkasir
'Menampilkan Grid sesuai dengan kriteria
.RecordSource = "select * from kasir where " & cbfilter.Text & " like '%" & tfilter.Text & "%' "
.Refresh
End With
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub tfilter_KeyPress(KeyAscii As Integer)
On Error GoTo pusing
If KeyAscii = 13 Then
With Rkasir
.RecordSource = "select * from kasir where " & cbfilter.Text & " like '%" & tfilter.Text & "%' "
.Refresh
'Jika data yang dicari tidak ada
If .Recordset.EOF Then
MsgBox "Data Tidak ada", vbOKOnly, "Cari"
Else
belakang
hidup
tampil
End If
End With
End If
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub Timer1_Timer()
'Membuat Judul For Berjalan
Me.Caption = Right(Me.Caption, 10) + Left(Me.Caption, 1)
End Sub
Private Sub tkode_KeyPress(KeyAscii As Integer)
On Error GoTo pusing
If KeyAscii = 13 Then
With Rkasir
Dim cari As String
cari = UCase(Trim(tkode.Text))
.RecordSource = "select * from kasir where kode_kasir= '" & cari & "'"
.Refresh
'Jika Kode Kasir Sudah ada
If Not .Recordset.EOF Then
MsgBox "Kode Kasir Sudah Ada", vbOKOnly, "Salah"
tkode.Text = ""
tkode.SetFocus
Else
tnama.SetFocus
End If
End With
End If
Exit Sub
pusing:
MsgBox Err.Number & Err.Description
End Sub
Private Sub tnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
tpass.SetFocus
End If
End Sub
Private Sub tpass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cblevel.SetFocus
End If
End Sub
Anonymous | On: 8 Juni 2010 pukul 06.01
MantaBBB banged dech ni...
tapi keterangan buat koneksi dari database k'ado'nya mana ya????
Anonymous | On: 8 Juni 2010 pukul 19.53
iya nih... bloom sempet bikin