Thursday, 28 February 2013

Progam Input Data Pasien



Scrup modul :
Public Kn As ADODB.Connection
Public Tb As ADODB.Recordset
Sub konek_database()
Set Kn = New ADODB.Connection
Kn.Provider = "microsoft.jet.oledb.4.0"
Kn.CursorLocation = adUseClient
Kn.Open App.Path & "\Rawat_Nginap.mdb"
End Sub
Sub TombolMati()
simpan.Visible = True: batal.Visible = True
baru.Visible = False: ubah.Visible = False: hapus.Visible = False: keluar.Visible = False
End Sub
Sub TombolHidup()
baru.Visible = True: ubah.Visible = True: hapus.Visible = True: keluar.Visible = True
simpan.Visible = False: batal.Value = False
End Sub
Private Sub a_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If a.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
a.SetFocus
Else
b.Locked = False: b.SetFocus
End If
End If
End Sub



Private Sub b_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If b.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
b.SetFocus
Else
c.Locked = False: c.SetFocus
End If
End If
End Sub
Private Sub c_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If c.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
c.SetFocus
Else
d.Locked = False: d.SetFocus
End If
End If
End Sub
Private Sub d_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If d.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
d.SetFocus
Else
e.Locked = False: e.SetFocus
End If
End If
If Not KeyAscii = 13 Then KeyAscii = 0
End Sub
Private Sub e_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If e.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
e.SetFocus
Else
f.Locked = False: f.SetFocus
End If
End If
End Sub
Private Sub f_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If f.Text = "" Then
MsgBox "DATA TIDAK BISA KOSONG", vbInformation, "PESAN"
f.SetFocus
Else
simpan.SetFocus
End If
End If
End Sub
Private Sub baru_Click()
KosongkanText
a.Locked = False: a.SetFocus
TombolMati
simpan.Caption = "SIMPAN"
End Sub
Private Sub batal_Click()
TombolHidup
KunciText
TampilData
End Sub
Private Sub Form_Activate()
Set DataGrid1.DataSource = Tb
End Sub
Private Sub Form_Load()
konek_database
Set Tb = New ADODB.Recordset
Tb.Open "select*from Tabel_Pasien order by KodePsn asc", Kn, adOpenDynamic, adLockOptimistic
TampilData
KunciText
End Sub
Sub TampilData()
a.Text = Tb.Fields("KodePsn")
b.Text = Tb.Fields("NamaPsn")
c.Text = Tb.Fields("AlamatPsn")
d.Text = Tb.Fields("GenderPsn")
e.Text = Tb.Fields("UmurPsn")
f.Text = Tb.Fields("TeleponPsn")
End Sub
Private Sub hapus_Click()
If Tb.RecordCount = 0 Then
MsgBox "DATA KOSONG", vbInformation, "PESAN"
Else
a = MsgBox("ANDA YAKIN INGIN MENGHAPUS DATA INI?", vbExclamation + vbYesNo, "PESAN")
If a = vbYes Then
With Tb
Tb.Delete
End With
End If
End If
End Sub
Private Sub keluar_Click()
End
End Sub
Sub KunciText()
a.Locked = True
b.Locked = True
c.Locked = True
d.Locked = True
e.Locked = True
f.Locked = True
End Sub
Sub BukaText()
a.Locked = False
b.Locked = False
c.Locked = False
d.Locked = False
e.Locked = False
f.Locked = False
End Sub
Sub KosongkanText()
a.Text = ""
b.Text = ""
c.Text = ""
d.Text = ""
e.Text = ""
f.Text = ""
End Sub
Private Sub simpan_Click()
If simpan.Caption = "UPDATE" Then
With Tb
.Fields("KodePsn") = a.Text
.Fields("NamaPsn") = b.Text
.Fields("AlamatPsn") = c.Text
.Fields("GenderPsn") = d.Text
.Fields("UmurPsn") = e.Text
.Fields("TeleponPsn") = f.Text
.Update
End With
TombolHidup
Else
With Tb
.AddNew
.Fields("KodePsn") = a.Text
.Fields("NamaPsn") = b.Text
.Fields("AlamatPsn") = c.Text
.Fields("GenderPsn") = d.Text
.Fields("UmurPsn") = e.Text
.Fields("TeleponPsn") = f.Text
.Update
End With
TombolHidup
End If
End Sub
Private Sub ubah_Click()
BukaText
TombolMati
simpan.Caption = "UPDATE"
End Sub
Keterangan :
Name Textbox 1=a dan seterusnya berabjat…
Command1  Caption = BARU dan Name =baru     dan seterusnya..\

No comments:

Post a Comment