Codding Visual Basic
|
Comments Off
Buatlah New Project lalu buat Project seperti gambar di bawah ini :
untuk Memunculkan DBGrid,Adodc1 kita harus membuka Component nya terlebih dahulu
kalian pasti udah bisa kan, kalau yang belum bisa ane kasih tau caranya...
1. klik kanan pada
Toolbar di sebelah kiri setelah di klik ada tulisan "Component" di klik
2. cari
-Microsoft ADO Data Control 6.0 (OLEDB),
-Microsoft DataGrid Control 6.0 (OLEDB),
-Microsoft Windows Common Controls 2.6.0
3.klik Apply > OK
4. Setelah itu masukan Component ADODC, DataGrid ke dalam form
5. Buat
MODULE caranya Klik kanan pada Project > Add >Module
6. Masukan Codding Berikut
GENERAL
Option Explicit
Dim Ldata As New ADODB.Recordset
Dim strsql As String
MODULE
Option Explicit
Public cn As New ADODB.Connection
Public Sub OpenConnection()
Set cn = New ADODB.Connection
With cn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb;Persist Security Info=False"
.CursorLocation = adUseClient
.Open
End With
End Sub
Nb: Tanda Merah itu anda Connection kan ulang Ke database Anda sendiri
SIMPAN
On Error GoTo salah
Dim strsql As String
If Text1.Text <> "" And Text2.Text <> "" And Text3.Text <> "" And Text4.Text <> "" Then
strsql = "insert into T_resep (nomor_resep,tgl_bayar,kode_dokter,kode_pasien,kode_PLK)" _
&
" values ('" & Text1.Text & "','" & DTPicker1.Value &
"', '" & Text2.Text & "','" & Text3.Text & "','" &
Text4.Text & "')"
cn.Execute strsql
MsgBox "Data Resep Tersimpan!", vbInformation, Me.Caption
Command3_Click
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
Command11_Click
Exit Sub
Else
MsgBox "Data Resep Belum Lengkap!", vbInformation, Me.Caption
Exit Sub
End If
salah:
MsgBox "Nomor_resep Tersebut Sudah Ada,Silahkan Ganti Yang Lain", vbInformation, Me.Caption
End Sub
EXIT
Private Sub Command5_Click()
End
End Sub
HAPUS
Private Sub Command2_Click()
Dim strsql As String
If MsgBox("Apakah Data Akan DiHapus ?" _
, vbQuestion + vbYesNo, "Hapus Data") = vbYes Then
strsql = "Delete from T_pembayaran where no_bayar = '" & Text1.Text & "'"
cn.Execute strsql, , adCmdText
MsgBox "Data Telah Terhapus !", vbInformation, Me.Caption
Command3_Click
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
End If
Exit Sub
End Sub
REFRESH
Private Sub Command3_Click()
Set Ldata = New ADODB.Recordset
Dim strsql As String
Set Ldata = Nothing
strsql = "select * from T_pembayaran order by no_bayar desc"
Ldata.Open strsql, cn, adOpenDynamic, adLockOptimistic, adCmdText
Tampilkan_Data
End Sub
EDIT
Private Sub Command4_Click()
Command1.Enabled = True
Command4.Visible = True
Command2.Enabled = False
Command1.Enabled = False
Command11.Enabled = True
Command6.Enabled = True
Command6.Visible = False
End Sub
AKHIR
Private Sub Command10_Click()
Ldata.MoveLast
Tampilkan_Data
End Sub
AWAL
Private Sub Command7_Click()
Ldata.MoveFirst
Tampilkan_Data
End Sub
MUNDUR
Private Sub Command8_Click()
Ldata.MovePrevious
Tampilkan_Data
End Sub
MAJU
Private Sub Command9_Click()
Ldata.MoveNext
Tampilkan_Data
End Sub
DATA GRID
Private Sub DataGrid1_Click()
On Error Resume Next
Tampilkan_Data
UPDATE
If Text1.Text <> "" And Text2.Text <> "" And Text3.Text <> "" Then
Set Ldata = Nothing
strsql
= "update T_pembayaran set tgl_bayar= '" & Me.DTPicker1.Value &
"', no_resep= '" & Me.Text2.Text & "', jumlah_bayar= '" &
Me.Text3.Text & "' where no_bayar='" & Trim(Text1.Text) &
"'"
cn.Execute strsql, , adCmdText
MsgBox "Data Pembayaran Telah Di Update!", vbInformation, Me.Caption
Command1.Enabled = True
Command2.Enabled = True
Command1.Enabled = True
Command11.Enabled = True
Command6.Visible = True
Command4.Visible = False
Command3_Click
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
Exit Sub
Else
MsgBox "Data pembayaran Belum Lengkap!", vbInformation, Me.Caption
Text2.SetFocus
Command3_Click
Exit Sub
End If
End sub
FORM LOAD
Private Sub Form_Load()
OpenConnection
Ldata.Open "select * from T_pembayaran order by no_bayar desc", cn, adOpenDynamic, adLockOptimistic
Tampilkan_Data
Command3_Click
End Sub
TAMPILKAN DATA
Private Sub Tampilkan_Data()
On Error Resume Next
With Ldata
Text1.Text = !no_bayar
DTPicker1.Value = !tgl_lahir
Text2.Text = !nomor_resep
Text3.Text = !jumlah_bayar
End With
Set DataGrid1.DataSource = Ldata.DataSource
DataGrid1.Refresh
Label6.Caption = "Jumlah Baris : " & Ldata.AbsolutePosition & " Dari : " & Ldata.RecordCountEnd Sub
PENCARIAN
Private Sub Text5_Change()
Dim strsql As String
If Combo1.ListIndex = 0 Then
Set Ldata = Nothing
strsql = "select* from T_pembayaran where no_bayar like'%" & Text4.Text & "%'"
Ldata.Open strsql, cn, adOpenKeyset, adLockBatchOptimistic, adCmdText
Tampilkan_Data
ElseIf Combo1.ListIndex = 1 Then
Set Ldata = Nothing
strsql = "select* from T_pembayaran where nomor_resep like'%" & Text4.Text & "%'"
Ldata.Open strsql, cn, adOpenKeyset, adLockBatchOptimistic, adCmdText
Tampilkan_Data
End If
End Sub
REPORT
Private Sub Command11_Click()
CrystalReport1.DataFiles(0) = App.Path & "\Siswa.mdb"
CrystalReport1.ReportFileName = App.Path & "\Report1.rpt"
CrystalReport1.WindowState = crptMaximized
CrystalReport1.RetrieveDataFiles
CrystalReport1.Action = 1
End Sub
TAMBAH
Private Sub Command12_Click()
autonis
Text1.Enabled = False
Text2.Text = ""
End Sub
AUTO NIS
Private Sub autono_bayar()
Dim strsql, auto As String
Set Ldata = Nothing
strsql = "select * from T_pembayaran order by no_bayar"
Ldata.Open strsql, cn, adOpenKeyset, adLockOptimistic, adCmdText
With Ldata
If .BOF And .EOF Then
auto = "DP000"
Else
Ldata.MoveLast
auto = Ldata!no_bayar
End If
auto = Format(Str(Val(Right$(auto, 3)) + 1), "000")
Text1.Text = "DP" & auto
End With
Set Ldata = Nothing
End Sub
untuk autonis itu buat sendiri bebas kalian mau buat di mana saja...
nah...di sini ane punya Codding Variasi nie / Tambahan Codding buat kalian..!!cekiiddoott dehh!!KeyPress,Form-Activate,IsNumeric
Private Sub DTPicker1_Change()
DTPicker1.DataFormat = Now
End Sub
Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text3.SetFocus
End If
End Sub
Private Sub Form_Activate()
Text2.SetFocus
End Sub
Private Sub Text2_Change()
If IsNumeric(Text2.Text) Then
Text2.Text = ""
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
DTPicker1.SetFocus
End If
End Sub
Private Sub Text3_Click()
If IsNumeric(Text3.Text) Then
Text3.Text = ""
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo1.SetFocus
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
End If
End Sub
Ane berterima kasih Kepada Bapak Mardy Turnip Guru Programer SMK MEDIKACOM BANDUNG
