Kode Program Pada Module
Public koneksi As New ADODB.Connection 'variabel koneksi database
Public Rs As New ADODB.Recordset 'variabel koneksi tabel
Sub Buka_db() 'sub untuk membuka database
If koneksi.State = adStateClosed Then
koneksi.CursorLocation = adUseClient
koneksi.Open "Provider=Microsoft.Jet.oledb.4.0;Data Source=" & _
App.Path & "\Database\data.mdb"
End If
End Sub
Sub Buka_tabel(tabel As String)
Rs.Open tabel, koneksi, adOpenKeyset, adLockOptimistic
End Sub
Sub Tutup_db() 'sub untuk menutup koneksi database
koneksi.Close
Set koneksi = Nothing
End Sub
Sub Tutup_tabel()
Rs.Close
Set Rs = Nothing
End Sub
Kode Program Pada Form
Dim rsSup As New ADODB.Recordset
Private Sub cmdCari_Click()
cari$ = InputBox("Masukan kode yang akan dicari..", "Pencarian Data", "Isikan Kode Hardware")
With Rs
If Not .EOF Then .MoveFirst
.Find "kdhard ='" & cari$ & "'"
If Not .EOF Then
TampilData
Else
MsgBox "Data belum terdaftar..", , "Informasi"
End If
End With
End Sub
Private Sub cmdTampil_Click()
Me.GrdSup.Visible = True
Me.GrdSup.SetFocus
End Sub
Private Sub Form_Load()
Me.Skin1.LoadSkin App.Path & "\skin\B-Studio.skn"
Me.Skin1.ApplySkin hWnd
Buka_db 'untuk membuka koneksi database
Buka_tabel "select * from hardware"
TampilData
Me.GrdSup.Visible = False
rsSup.Open "select kdspl as Kode,nmspl as Nama from supplier", koneksi, adOpenKeyset, adLockReadOnly
Set Me.GrdSup.DataSource = rsSup
End Sub
Sub TampilData()
With Rs
If .RecordCount > 0 Then
'tampilkan datanya
For i = 0 To Me.txtBarang.UBound
Me.txtBarang(i).Text = .Fields(i)
Next
If .Fields(8) <> "-" Then
Me.imgFoto.Picture = LoadPicture(App.Path & "\Foto\" & Rs.Fields(8))
Else
Me.imgFoto.Picture = LoadPicture("")
End If
Else
'data kosong
MsgBox "Data barang masih kosong..", , "Informasi"
End If
End With
End Sub
Sub TxtKosong()
For i = 0 To Me.txtBarang.UBound
Me.txtBarang(i).Text = ""
Next
Me.imgFoto.Picture = LoadPicture("")
End Sub
Private Sub GrdSup_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then 'ketika grid di enter
Me.txtBarang(6).Text = Me.GrdSup.Columns(0).Text
Me.GrdSup.Visible = False
Me.txtBarang(7).SetFocus
End If
End Sub
Private Sub TambahFoto_Click()
With Me.Dlg1
.DialogTitle = "Cari Foto"
.Filter = "*.jpg"
.ShowOpen
If .FileName <> "" Then
Me.imgFoto.Picture = LoadPicture(.FileName)
End If
End With
End Sub
Private Sub Tombol_Operasi_Click(Index As Integer)
Select Case Index
Case 0 'tambah
If Me.Tombol_Operasi(0).Caption = "&Tambah" Then
Me.Tombol_Operasi(0).Caption = "&Batal"
TxtKosong
Rs.AddNew
Me.txtBarang(0).SetFocus
Else
Me.Tombol_Operasi(0).Caption = "&Tambah"
Rs.CancelBatch adAffectCurrent
Rs.MoveFirst
TampilData
End If
Case 1 'simpan
If Me.Dlg1.FileName <> "" Then
FileCopy Me.Dlg1.FileName, App.Path & "\Foto\" & _
Me.txtBarang(0).Text & ".jpg"
foto$ = Me.txtBarang(0).Text & ".jpg"
Else
foto$ = "-"
End If
Rs.Fields(i) = Me.txtBarang(i).Text
Rs.Fields(1) = Me.txtBarang(1).Text
Rs.Fields(2) = Me.txtBarang(2).Text
Rs.Fields(3) = Me.txtBarang(3).Text
Rs.Fields(4) = Me.txtBarang(4).Text
Rs.Fields(5) = Me.txtBarang(5).Text
Rs.Fields(6) = Me.txtBarang(6).Text
Rs.Fields(7) = Me.txtBarang(7).Text
Rs.Fields(8) = foto$
Rs.Update
MsgBox "Data sudah tersimpan..", , "Informasi"
Case 2 'rubah
Me.txtBarang(1).SelStart = 0
Me.txtBarang(1).SelLength = Len(Me.txtBarang(1).Text)
Me.txtBarang(1).SetFocus
Case 3 'hapus
With Rs
If Not .EOF Then .MoveFirst
.Find "kdhard ='" & Me.txtBarang(0).Text & "'"
If Not .EOF Then
.Delete
MsgBox "Data sudah terhapus..", , "informasi"
.MoveFirst
TampilData
End If
End With
End Select
End Sub
=======================
Selamat mencoba!
