beberapa rumus visual basic dengan database
RUMUS SIMPAN dan rumus jika data yang dimsukkan tidak bisa dimasukkan
Private Sub CMD SIMPAN_Click()
On Error GoTo Errsimpan
DB.Execute " Insert into BARANG(KODE_BARANG,NAMA_BARANG
5.Text & ",'" & Combo2.Text & "')"
MsgBox "DATA BERHASIL DI SIMPAN"
Errsimpan:
If Err.Number <> 0 Then
If Err.Number = -2147217900 Or Err.Number = -2147467259 Then
MsgBox "DATA SUDAH TERDAFTAR", vbInformation, "INFORMASI"
Else
MsgBox CStr(Err.Number) & "" & Err.Description
End If
End If
Text6 = Val(Text3) * Val(Text5)
End Sub
RUMUS KONEKSI
Dim RS As ADODB.Recordset
Dim DB As ADODB.Connection
Private Sub form_load()
Set DB = New ADODB.Connection
DB.Open "Provider=Microsoft.Jet.OLEDB.
MsgBox "DATABASE SUDAH TERKONEKSI KE VISUAL BASIC", vbInformation, "PEMBERITAHUAN DARI SIDIQ"
End sub
RUMUS CARI
PRIVATE SUB CMD CARI()
Dim R As New ADODB.Recordset
R.CursorLocation = adUseClient
SQL = "SELECT KODE_BARANG, NAMA_BARANG, SATUAN, JUMLAH_BARANG, HARGA_BELI, HARGA_JUAL, TYPE_BARANG FROM BARANG WHERE KODE_BARANG='" & Text1.Text & "'"
R.Open SQL, DB, adOpenStatic, adLockReadOnly
If Not R.EOF Then
Text1.Text = R("KODE_BARANG")
Text2.Text = R("NAMA_BARANG")
Combo1.Text = R("SATUAN")
Text3.Text = R("JUMLAH_BARANG")
Text4.Text = R("HARGA_BELI")
Text5.Text = R("HARGA_JUAL")
Combo2.Text = R("TYPE_BARANG")
MsgBox "DATA SUDAH ADA"
Command1.Enabled = False
Else
Text1.Text = ""
Text2.Text = ""
Combo1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Combo2.Text = ""
Text6.Text = ""
End If
R.Close
END SUB
Rumus tampil data
Private sub cmd tampil
Dim K As New ADODB.Recordset
K.CursorLocation = adUseClient
If K.State = 1 Then K.Close
K.Open " select* FROM DATA", DB, adOpenStatic, adLockReadOnly
Set DataGrid1.DataSource = K
DataGrid1.MarqueeStyle = dbgHighlightRowRaiseCell
DataGrid1.Refresh
End sub
Rumus update
Db.excute “updte nama table set fiel1=’” & text1.text & “’, field2=’” & text2.text & “’ where primary key=’” & text apa & “’”
Contoh:
Private Sub Cmd updete_Click()
DB.Execute "update DATA set NIM='" & Text1.Text & "',NAMA_LENGKAP='" & Text2.Text & "',KOTA_TEMPAT_LAHIR='" & Text3.Text & "',TANGGAL_LAHIR='" & Text4.Text & "',NO_TELEPON='" & Text5.Text & "',ALAMAT='" & Text6.Text & "' WHERE NIM =" & Text1.Text & ""
End Sub
RUMUS DELETE DATA BASE
DB.Execute "deleTe from nama tabel where primary key='" & Text apa & "'"
Private Sub CMD delete_Click()
DB.Execute "deleTe from DATA where NIM='" & Text1.Text & "'"
End Sub
MsgBox "DATA BERHASIL DI SIMPAN"
Errsimpan:
If Err.Number <> 0 Then
If Err.Number = -2147217900 Or Err.Number = -2147467259 Then
MsgBox "DATA SUDAH TERDAFTAR", vbInformation, "INFORMASI"
Else
MsgBox CStr(Err.Number) & "" & Err.Description
End If
End If
Text6 = Val(Text3) * Val(Text5)
End Sub
RUMUS KONEKSI
Dim RS As ADODB.Recordset
Dim DB As ADODB.Connection
Private Sub form_load()
Set DB = New ADODB.Connection
DB.Open "Provider=Microsoft.Jet.OLEDB.
MsgBox "DATABASE SUDAH TERKONEKSI KE VISUAL BASIC", vbInformation, "PEMBERITAHUAN DARI SIDIQ"
End sub
RUMUS CARI
PRIVATE SUB CMD CARI()
Dim R As New ADODB.Recordset
R.CursorLocation = adUseClient
SQL = "SELECT KODE_BARANG, NAMA_BARANG, SATUAN, JUMLAH_BARANG, HARGA_BELI, HARGA_JUAL, TYPE_BARANG FROM BARANG WHERE KODE_BARANG='" & Text1.Text & "'"
R.Open SQL, DB, adOpenStatic, adLockReadOnly
If Not R.EOF Then
Text1.Text = R("KODE_BARANG")
Text2.Text = R("NAMA_BARANG")
Combo1.Text = R("SATUAN")
Text3.Text = R("JUMLAH_BARANG")
Text4.Text = R("HARGA_BELI")
Text5.Text = R("HARGA_JUAL")
Combo2.Text = R("TYPE_BARANG")
MsgBox "DATA SUDAH ADA"
Command1.Enabled = False
Else
Text1.Text = ""
Text2.Text = ""
Combo1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Combo2.Text = ""
Text6.Text = ""
End If
R.Close
END SUB
Rumus tampil data
Private sub cmd tampil
Dim K As New ADODB.Recordset
K.CursorLocation = adUseClient
If K.State = 1 Then K.Close
K.Open " select* FROM DATA", DB, adOpenStatic, adLockReadOnly
Set DataGrid1.DataSource = K
DataGrid1.MarqueeStyle = dbgHighlightRowRaiseCell
DataGrid1.Refresh
End sub
Rumus update
Db.excute “updte nama table set fiel1=’” & text1.text & “’, field2=’” & text2.text & “’ where primary key=’” & text apa & “’”
Contoh:
Private Sub Cmd updete_Click()
DB.Execute "update DATA set NIM='" & Text1.Text & "',NAMA_LENGKAP='" & Text2.Text & "',KOTA_TEMPAT_LAHIR='" & Text3.Text & "',TANGGAL_LAHIR='" & Text4.Text & "',NO_TELEPON='" & Text5.Text & "',ALAMAT='" & Text6.Text & "' WHERE NIM =" & Text1.Text & ""
End Sub
RUMUS DELETE DATA BASE
DB.Execute "deleTe from nama tabel where primary key='" & Text apa & "'"
Private Sub CMD delete_Click()
DB.Execute "deleTe from DATA where NIM='" & Text1.Text & "'"
End Sub
Rabu, 03 Oktober 2012
