http://j-coder.blogspot.co.id/
Creative Project By Juwendi.
Deklarasi
ADODB.
Dim DataBarang As New ADODB.Recordset
Fungsi
Load Field Database.
Set DataBarang = New ADODB.Recordset ‘[Penerapan Koneksi]
DataBarang.Open
"SELECT * from Barang", con, adOpenDynamic, adLockPessimistic ‘
If DataBarang.State = 1 Then Set DataBarang = Nothing
DataBarang.CursorLocation
= adUseClient
DataBarang.Open
"SELECT * FROM [Barang] ORDER BY [Kode Barang]", con, adOpenDynamic,
adLockOptimistic
DataBarang.Requery
dview
Hapus Field.
Dim rsHapus As
New ADODB.Recordset
If rsHapus.State
= 1 Then Set rsHapus = Nothing
rsHapus.Open "SELECT * from [Barang] where [Kode Barang]='" & txtID.Text
& "'", con, adOpenDynamic, adLockPessimistic
With rsHapus
If Not .EOF Then
pesan = MsgBox("Apakah Anda
Ingin Menghapusnya ?", vbCritical + vbYesNo, "Hapus?")
If pesan = vbYes Then
.Delete
.Requery
.Close
End If
Else
MsgBox "Data Sudah Dihapus !",
vbExclamation + vbOKOnly
End If
End With
Edit Field.
Dim rsBarang As
New ADODB.Recordset
If rsBarang.State
= 1 Then Set rsBarang = Nothing
rsBarang.Open "SELECT * from [Barang] where [Kode Barang] ='" & txtID.Text & "'", con, adOpenDynamic,
adLockPessimistic
With rsBarang
con.BeginTrans
.Fields(0) = txtID.Text
.Fields(1) = UCase(txtNama.Text)
.Update
.Requery
con.CommitTrans
.Close
End With
Set rsBarang =
Nothing
Menyimpan Field.
If txtNama.Text = "" Then
MsgBox "Mohon Isi Nama Barang !",
vbInformation + vbOKOnly
Else
With DataBarang
con.BeginTrans
.AddNew
.Fields(0) = txtID.Text
.Fields(1) = UCase(txtNama.Text)
.Update
.Requery
con.CommitTrans
End With
End If
Mencari Data.
If DataBarang.State = 1 Then Set DataBarang = Nothing
Pencarian =
"SELECT * from [Barang] where [Kode Barang] like '" & Trim(txtCari) & "%'"
DataBarang.Open
Pencarian, con, adOpenKeyset, adLockOptimistic
lv.ListItems.Clear
dview
Fungsi
Listview Ke Textbox.
Private Sub
lv_Click()
On Error Resume
Next
btnEdit.Enabled =
True
btnDelete.Enabled
= True
txtID.Text =
lv.SelectedItem.Text
Text1.Text =
lv.SelectedItem.SubItems(1)
End Sub
Fungsi Penampilan Data Pada Listview .
Private Sub
dview()
On Error Resume
Next
Do While Not DataBarang.EOF
Set ls = lv.ListItems.Add(, , DataBarang.Fields(0))
ls.SubItems(1) = DataBarang.Fields(1)
DataBarang.MoveNext
Loop
End Sub
Modul
Kit Koneksi.
Public con As New ADODB.Connection
Dim cmd As New ADODB.Command
Public rs As New ADODB.Recordset
Public Pencarian As String
Public rsJumlah As Long
Sub Main()
On Error Resume Next
con.ConnectionString =
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path &
“\Database.mdb” & "; Persist
Security Info=False;"
con.CursorLocation = adUseClient
con.Open
With cmd
.ActiveConnection = con
.CommandText =
strSQLmarketing
.CommandType =
adCmdText
End With
With rs
.CursorType =
adOpenStatic
.CursorLocation
= adUseClient
.LockType =
adLockOptimistic
.Open cmd
End With
Splash.Show
End Sub
Public Function getquantity() As Single
getquantity = rsJumlah
End Function
Public Function TxtBoxIsEmpty(t As Object, tcounter As
Integer) As Boolean
Dim i As Integer
For i = 0 To tcounter - 1
If t(i).Text =
"" Then
TxtBoxIsEmpty = True
End If
Next i
End Function
Public Sub Cleartext(t As Object, tcounter As Integer)
Dim i As Integer
For i = 0 To tcounter - 1
t(i).Text =
""
Next i
End Sub
Public Sub AllowNumbersOnly(KeyAscii As Integer)
Select Case KeyAscii
Case
Asc("0") To Asc("9")
Case
Str("8")
Case Else
KeyAscii = 0
End Select
End Sub
Public Sub AllowNumbersOnlyDot(KeyAscii As Integer)
Select Case KeyAscii
Case Asc("0")
To Asc("9")
Case
Asc(".")
Case
Str("8")
Case Else
KeyAscii = 0
End Select
End Sub
Public Sub LoadForm(ByRef srcForm As Form)
srcForm.Show
srcForm.WindowState = vbMaximized
srcForm.SetFocus
End Sub







0 comments:
Post a Comment