11.13.2009

Function

1. Private Function kunci(cek As Boolean)
kd_brg.Enabled = cek
nm_brg.Enabled = cek
Harsat.Enabled = cek
stuan.Enabled = cek
End Function

2. Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
On Error Resume Next
If MsgBox("Yakin data akan di hapus?", 20, "Hapus") = vbNo Then
Cancel = True
Else
Cancel = False
Response = ac.datacontinue
End If
3.Private Sub Form_Load()
kunci (False)
End Sub
4.Private Sub kd_brg_BeforeUpdate(Cancel As Integer)
On Error GoTo cari
Dim cekkode As String
cekkode = DLookup("[kd_brg]", "[barang]", "[kd_brg],'" & "'")
If Not IsNull(cekkode) Then
MsgBox "Kd_brg" + kd_brg + "Sudah ada", 64, "Informasi"
DoCmd.CancelEvent
kunci False
End If
cari:
Exit Sub
End Sub
5. Private Sub cmd_edit_Click()
kunci (True)
kd_brg.SetFocus
End Sub
6. Private Sub cmd_tambah_Click()
On Error GoTo Err_cmd_tambah_Click
Me.AllowAdditions = True
kunci True
DoCmd.GoToRecord , , acNewRec
kd_brg.SetFocus
Exit_cmd_tambah_Click:
Exit Sub
Err_cmd_tambah_Click:
MsgBox Err.Description
Resume Exit_cmd_tambah_Click
End Sub
7. Private Sub cmd_simpan_Click()
On Error GoTo Err_cmd_simpan_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Me.AllowAdditions = False
kunci False
Exit_cmd_simpan_Click:
Exit Sub
Err_cmd_simpan_Click:
MsgBox Err.Description
Resume Exit_cmd_simpan_Click
End Sub
8. Private Sub cmd_batal_Click()
On Error GoTo Err_cmd_batal_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
kunci False
Exit_cmd_batal_Click:
Exit Sub
Err_cmd_batal_Click:
MsgBox Err.Description
Resume Exit_cmd_batal_Click
End Sub
9. Private Sub cmd_find_Click()
On Error GoTo Err_cmd_find_Click
kunci True
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_cmd_find_Click:
Exit Sub
Err_cmd_find_Click:
MsgBox Err.Description
Resume Exit_cmd_find_Click
End Sub
10. Private Sub cmd_kluar_Click()
On Error GoTo Err_cmd_kluar_Click
x = MsgBox("yakin mau keluar", vbQuestion + vbYesNo, "info")
If x = vbYes Then
DoCmd.Close
End If
Exit_cmd_kluar_Click:
Exit Sub
Err_cmd_kluar_Click:
MsgBox Err.Description
Resume Exit_cmd_kluar_Click
End Sub

Tidak ada komentar:

Posting Komentar