ne ccuma iseng maen vb, kalo ada yg salah, mohon koreksi,,
untuk nyoba, silakan buat database dulu, " db1.mdb "
'awal coding _________________________
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Sub buka()
Dim strkon As String
If con.State = adStateOpen Then con.Close
strkon = "provider=microsoft.jet.oledb.4.0;data source = " + App.Path + "\db1.mdb"
con.Open strkon
End Sub
Sub openrec(str As String)
If rs.State = adStateOpen Then rs.Close
rs.Open str, con, adOpenKeyset, adLockOptimistic, adCmdText
End Sub
Function ribuan(ByVal teks As String) As String
ribuan = Format(teks, "###,0")
End Function
Private Sub Form_Load()
Dim lv As ListItem
Call buka
openrec "select * from barang"
tampil
'ISI
End Sub
Sub tampil()
Me.ListView1.ListItems.Clear
If Not rs.EOF Then
rs.MoveFirst
For i = 1 To rs.RecordCount
Set lv = ListView1.ListItems.Add(, , rs(0))
lv.SubItems(1) = rs(1)
lv.SubItems(2) = rs(2)
lv.SubItems(3) = "Rp " + ribuan(rs(3))
lv.SubItems(4) = rs(4)
'lv.SubItems(5) = rs(5)
rs.MoveNext
Next
Else
MsgBox "Tidak ada data pada database.", vbCritical
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If rs.State = adStateClosed Then rs.Open
If rs.RecordCount > 0 Then
rs.MoveFirst
'i = Val(Me.ListView1.SelectedItem)
'For i = 0 To rs.RecordCount
'rs(i) = Me.ListView1.SelectedItem
ISI
'Next
End If
End Sub
Private Sub Option1_Click()
Me.Text1.SetFocus
End Sub
Private Sub Option2_Click()
Me.Text1.SetFocus
End Sub
Private Sub Text1_Change()
If Len(Me.Text1.Text) = 0 Then
rs.Filter = adFilterNone
ElseIf Option1.Value = True Then
Me.Text1.SetFocus
rs.Filter = "kdbarang like '%" & Me.Text1.Text & "%'"
ElseIf Option2.Value = True Then
Me.Text1.SetFocus
rs.Filter = "jenis like '%" & Me.Text1.Text & "%'"
End If
If rs.RecordCount > 0 Then
tampil
Else
MsgBox "Data Kosong", vbCritical, "KOSONG"
End If
'Me.Text1.Visible = False
End Sub
Sub ISI()
If rs.State = adStateClosed Then rs.Open
If rs.RecordCount > 0 Then
'rs.MoveFirst
Me.Image1.Picture = LoadPicture(App.Path & "\" & rs.Fields(5))
End If
End Sub
'selesai_____________________________
semoga bermanfaat
go VB
untuk nyoba, silakan buat database dulu, " db1.mdb "
'awal coding _________________________
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Sub buka()
Dim strkon As String
If con.State = adStateOpen Then con.Close
strkon = "provider=microsoft.jet.oledb.4.0;data source = " + App.Path + "\db1.mdb"
con.Open strkon
End Sub
Sub openrec(str As String)
If rs.State = adStateOpen Then rs.Close
rs.Open str, con, adOpenKeyset, adLockOptimistic, adCmdText
End Sub
Function ribuan(ByVal teks As String) As String
ribuan = Format(teks, "###,0")
End Function
Private Sub Form_Load()
Dim lv As ListItem
Call buka
openrec "select * from barang"
tampil
'ISI
End Sub
Sub tampil()
Me.ListView1.ListItems.Clear
If Not rs.EOF Then
rs.MoveFirst
For i = 1 To rs.RecordCount
Set lv = ListView1.ListItems.Add(, , rs(0))
lv.SubItems(1) = rs(1)
lv.SubItems(2) = rs(2)
lv.SubItems(3) = "Rp " + ribuan(rs(3))
lv.SubItems(4) = rs(4)
'lv.SubItems(5) = rs(5)
rs.MoveNext
Next
Else
MsgBox "Tidak ada data pada database.", vbCritical
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If rs.State = adStateClosed Then rs.Open
If rs.RecordCount > 0 Then
rs.MoveFirst
'i = Val(Me.ListView1.SelectedItem)
'For i = 0 To rs.RecordCount
'rs(i) = Me.ListView1.SelectedItem
ISI
'Next
End If
End Sub
Private Sub Option1_Click()
Me.Text1.SetFocus
End Sub
Private Sub Option2_Click()
Me.Text1.SetFocus
End Sub
Private Sub Text1_Change()
If Len(Me.Text1.Text) = 0 Then
rs.Filter = adFilterNone
ElseIf Option1.Value = True Then
Me.Text1.SetFocus
rs.Filter = "kdbarang like '%" & Me.Text1.Text & "%'"
ElseIf Option2.Value = True Then
Me.Text1.SetFocus
rs.Filter = "jenis like '%" & Me.Text1.Text & "%'"
End If
If rs.RecordCount > 0 Then
tampil
Else
MsgBox "Data Kosong", vbCritical, "KOSONG"
End If
'Me.Text1.Visible = False
End Sub
Sub ISI()
If rs.State = adStateClosed Then rs.Open
If rs.RecordCount > 0 Then
'rs.MoveFirst
Me.Image1.Picture = LoadPicture(App.Path & "\" & rs.Fields(5))
End If
End Sub
'selesai_____________________________
semoga bermanfaat
go VB