saya baru belajar access dan sekarang sedang coba bikin program perpus utk
sekolah saya pk access 200 tp ga jalan kode VB nya kata temen ada yang
salah,mohon bantuannya utuk memperbaikinya
salahnya di mana ya pak?
Option Compare Database
Private Function InputanLengkap() As Boolean
On Error Resume Next
If IsNull(Me![KeyItem]) Or IsNull(Me![NoItem]) Or IsNull(Me![NoUrut])
InputanLengkap = False
Else
InputanLengkap = True
End If
End Function
Private Sub BUTCari_AfterUpdate()
On Error Resume Next
Me.RecordsetClone.FindFirst "[KeyItem] = '" & Me![BUTCari] & "'"
Me.Bookmark = Me.RecordsetClone.Bookmark
End Sub
Private Sub BUTCari_GotFocus()
On Error Resume Next
Me.BUTCari.Requery
End Sub
Private Sub BUTCopy_Click()
On Error Resume Next
Dim DbItem As Database
Dim RsItem As Recordset
Dim NewKeyItem As String
Dim TempNo As Long
If InputanLengkap Then
Call SimpanData("Simpan Item")
Set DbItem = CurrentDb
Set RsItem = DbItem.OpenRecordset("SELECT TBLItem.* FROM TBLItem WHERE
TBLItem.NoItem='" & Me!NoItem & "'", dbOpenDynaset)
If RsItem.EOF Then
TempNo = 1
Else
TempNo = Nz(DMax("NoUrut", "TBLItem", "NoItem='" & Me!NoItem &
"'"), 0) + 1
End If
NewKeyItem = Me!NoItem & "-" & Format(TempNo, "000")
RsItem.AddNew
RsItem!KeyItem = NewKeyItem
RsItem!NoItem = Me!NoItem
RsItem!NoUrut = Format(TempNo, "000")
RsItem!Keterangan = Me!Keterangan
RsItem!KodeGroup = Me!KodeGroup
RsItem!Pengarang = Me!Pengarang
RsItem!Penerbit = Me!Penerbit
RsItem!Note = Me!Note
RsItem!Note = Me!Note
RsItem.Update
DbItem.Close
Me.Requery
Me.RecordsetClone.FindFirst "[KeyItem] = '" & NewKeyItem & "'"
Me.Bookmark = Me.RecordsetClone.Bookmark
End If
End Sub
Private Sub BUTDelete_Click()
On Error GoTo Err_BUTDelete_Click
Dim DbPinjam As Database
If MsgBox("Apakah anda ingin menghapus item dengan No. Induk : " &
Me!KeyItem & "?", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
Set DbPinjam = CurrentDb
DbPinjam.Execute "Delete TBLItem.* FROM TBLItem.KeyItem='" & Me!KeyItem
& "'"
Me.Requery
DoCmd.GoToRecord , , acNewRec
DbPinjam.Close
End If
Exit_BUTDelete_Click:
Exit Sub
Err_BUTDelete_Click:
MsgBox Err.Description, , Me.Caption
Resume Exit_BUTDelete_Click
End Sub
Private Sub BUTExit_Click()
On Error Resume Next
DoCmd.Close
End Sub
Private Sub Form_Current()
On Error Resume Next
If Me.NewRecord Then
Me.BUTDelete.Enabled = False
Me.BUTCopy.Enabled = False
Else
Me.BUTDelete.Enabled = True
Me.BUTCopy.Enabled = True
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
DoCmd.GoToRecord , , acNewRec
Me.NoItem.SetFocus
End Sub
Private Sub Keterangan_AfterUpdate()
On Error Resume Next
If InputanLengkap Then Call SimpanData("Simpan Item")
End Sub
Private Sub KodeGroup_AfterUpdate()
On Error Resume Next
If InputanLengkap Then Call SimpanData("Simpan Item")
End Sub
Private Sub KodeGroup_GotFocus()
On Error Resume Next
Me.KodeGroup.Requery
End Sub
Private Sub NoItem_AfterUpdate()
On Error Resume Next
Dim DbItem As Database
Dim RsItem As Recordset
Dim TempNo As Long
Set DbItem = CurrentDb
Set RsItem = DbItem.OpenRecordset("SELECT TBLItem.* FROM TBLItem WHERE
TBLItem.NoItem='" & Me!NoItem & "'", dbOpenSnapshot)
If RsItem.EOF Then
TempNo = 1
Else
TempNo = Nz(DMax("NoUrut", "TBLItem", "NoItem='" & Me!NoItem & "'"), 0)
+ 1
End If
Me!KeyItem = Me!NoItem & "-" & Format(TempNo, "000")
Me!NoUrut = Format(TempNo, "000")
If InputanLengkap Then Call SimpanData("Simpan Item")
DbItem.Close
End Sub
Private Sub NoItem_GotFocus()
On Error Resume Next
Me.NoItem.Requery
End Sub
