Dokter

'pendeklarasian Option Explicit Dim conAVB As ADODB.Connection Dim rsdokter As ADODB.Recordset Private Sub Form_Load() Set conAVB = New ADODB.Connection conAVB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Persist Security Info=False;Data Source=" & App.Path & _ "\rumahsakit.mdb;Mode = readwrite" conAVB.Open Dim strSQL1 As String 'Buat recordset Set rsdokter = New ADODB.Recordset strSQL1 = "Select * from dokter" rsdokter.Open strSQL1, conAVB, adOpenDynamic, adLockOptimistic, adCmdText End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then On Error Resume Next rsdokter.Find "ID_DOKTER = '" & Text1 & "'" Text2.Text = rsdokter.Fields(1) Text3.Text = rsdokter.Fields(2) Text4.Text = rsdokter.Fields(3) Text5.Text = rsdokter.Fields(4) Text6.Text = rsdokter.Fields(5) Text7.Text = rsdokter.Fields(6) Text8.Text = rsdokter.Fields(7) Text9.Text = rsdokter.Fields(8) Text10.Text = rsdokter.Fields(9) End If End Sub Private Sub cmdtambah_Click() 'Tambah data record baru If cmdtambah.Caption = "TAMBAH" Then BersihkanFieldText nonAktifkanTombol 'Disable navigation cmdsimpan.Enabled = True cmdtambah.Caption = "Batal" Else rsdokter.CancelUpdate 'Cancel the Tambah Text1.Enabled = True AktifkanTombol 'Enable navigation cmdsimpan.Enabled = False 'Disable the Save button cmdtambah.Caption = "TAMBAH" 'Reset the Tambah button rsdokter.MoveFirst TampilkanData End If End Sub Private Sub AktifkanTombol() 'tombol-tombol navigasi diaktifkan cmdhapus.Enabled = True cmdubah.Enabled = True End Sub Private Sub nonAktifkanTombol() 'Tombol-tombol naviga dinonaktifkan cmdhapus.Enabled = False cmdubah.Enabled = False End Sub Private Sub TampilkanData() 'Transer dari database With rsdokter Text1.Text = rsdokter.Fields(0) Text2.Text = rsdokter.Fields(1) Text3.Text = rsdokter.Fields(2) Text4.Text = rsdokter.Fields(3) Text5.Text = rsdokter.Fields(4) Text6.Text = rsdokter.Fields(5) Text7.Text = rsdokter.Fields(6) Text8.Text = rsdokter.Fields(7) Text9.Text = rsdokter.Fields(8) Text10.Text = rsdokter.Fields(9) End With Adodc1.Refresh End Sub Private Sub cmdubah_Click() editdata Adodc1.Refresh End Sub Private Sub editdata() If cmdubah.Caption = "UBAH" Then Text1.Enabled = False cmdubah.Caption = "Update" Else Dim sql As String Set rsdokter = New ADODB.Recordset sql = "select * from dokter where ID_DOKTER like '" & Text1.Text & "'" rsdokter.Open sql, conAVB, adOpenDynamic, adLockOptimistic, adCmdText With rsdokter ' With rsdokter .Fields(0) = Text1.Text .Fields(1) = Text2.Text .Fields(2) = Text3.Text .Fields(3) = Text4.Text .Fields(4) = Text5.Text .Fields(5) = Text6.Text .Fields(6) = Text7.Text .Fields(7) = Text8.Text .Fields(8) = Text9.Text .Fields(9) = Text10.Text .Update End With cmdubah.Caption = "UBAH" End If Adodc1.Refresh End Sub Private Sub cmdSimpan_Click() simpandata Adodc1.Refresh End Sub Private Sub simpandata() 'On Error Resume Next 'Simpan record yang sedang aktif With rsdokter .AddNew .Fields(0) = Text1.Text .Fields(1) = Text2.Text .Fields(2) = Text3.Text .Fields(3) = Text4.Text .Fields(4) = Text5.Text .Fields(5) = Text6.Text .Fields(6) = Text7.Text .Fields(7) = Text8.Text .Fields(8) = Text9.Text .Fields(9) = Text10.Text .Update End With Adodc1.Refresh AktifkanTombol cmdsimpan.Enabled = False cmdtambah.Caption = "TAMBAH" TampilkanData 'cmdsimpan_click_exit: End Sub Private Sub cmdHapus_Click() HapusData Adodc1.Refresh End Sub Private Sub HapusData() Dim y As VbMsgBoxResult y = MsgBox("Apakah Anda Yakin Ingin Menghapus Data.?", vbOKCancel + vbInformation, "Informasi") If y = vbOK Then Dim sql As String Set rsdokter = New ADODB.Recordset sql = "select * from dokter where ID_DOKTER like'" & Text1.Text & "'" rsdokter.Open sql, conAVB, adOpenDynamic, adLockOptimistic, adCmdText With rsdokter .Fields(0) = Text1.Text .Fields(1) = Text2.Text .Fields(2) = Text3.Text .Fields(3) = Text4.Text .Fields(4) = Text5.Text .Fields(5) = Text6.Text .Fields(6) = Text7.Text .Fields(7) = Text8.Text .Fields(8) = Text9.Text .Fields(9) = Text10.Text .Delete Adodc1.Refresh End With On Error GoTo 0 MsgBox ("Data Sudah Terhapus") BersihkanFieldText Else Exit Sub End If Adodc1.Refresh End Sub Private Sub BersihkanFieldText() 'Bersihkan semua text boxes untuk sebuah proses penambahan data Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" Text7.Text = "" Text8.Text = "" Text9.Text = "" Text10.Text = "" Text1.SetFocus End Sub Private Sub cmdkeluar_click() If MsgBox("Apakah anda yakin ingin keluar ?", vbQuestion + vbYesNo, "KELUAR ?") = vbYes Then Unload Me End If End Sub Private Sub cmdrefresh_Click() Unload Me Form2.Show End Sub Private Sub cmdpasien_Click() Unload Me Form1.Show End Sub Private Sub cmddokter_Click() Unload Me Form2.Show End Sub Private Sub cmdpemeriksaan_Click() Unload Me Form3.Show End Sub