--- In indoprog-vb@yahoogroups.com, SELVI OYE
para pakar VB, minta tolong dong dgn scrip berikut :
Database acces.
Table Film :
-Â Â Â Â Â Â Â kode_film
-Â Â Â Â Â Â Â judul
-Â Â Â Â Â Â Â qty
-       status ( “ada†& “keluarâ€)
Â
kronologisnya :
jika judul film dgn qty 3 dan dipinjam 1 berarti tinggal 2 dgn status
“keluarâ€.
Nah jika film akan dihapus dari database, maka akan diselecsi dgn status
“ada†jadi jika status ada maka bisa dihapus.
Â
Ok, selanjutnya aku udah bikin scrip di Vb seperti ini :
Â
Private Sub listView1_DblClick()
On Error GoTo ErrPesan
Dim i As Integer
Dim TempIndex As Integer
Dim strSQL As String
Dim tempKode, tempstatus As String
Â
Â
   If listView1.ListItems.Count = 0 Then
        Exit Sub
   End If
Â
 TempIndex = listView1.SelectedItem.Index
 tempKode = listView1.ListItems.Item(TempIndex)
Â
  'Konfirmasi penghapusan record
 Â
 jawab = MsgBox("Apakah Anda yakin Data " & kode_film & _
 vbCrLf & " Akan dihapus ? ", vbInformation + vbYesNo)
 If jawab = vbNo Then Exit Sub
 con.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path &
"\rental1.mdb"
 If rsfilm.Fields("status") = "ADA" Then
       strSQL = "DELETE FROM film where kode_film = '" & tempKode & "'"
      Â
       con.Execute strSQL
       MsgBox "DATA FILM TELAH DIHAPUS"
Â
 label6.Caption = "Total Record : " & rsfilm.RecordCount
 i = listView1.SelectedItem.Index
 listView1.ListItems.Remove i
 End If
 Exit Sub
ErrPesan:
  MsgBox "Data belum bisa dihapus " & vbCrLf & " Film Masih diPinjam ",
vbInformation
 End Sub
Â
Tapi yg ada adalah masuk ke errpesan, sehingga data tidak bisa dihapus.
Mohon petunjuknya.
Dear Selvi,
Coba anda ganti kode anda menjadi seperti ini:
Private Sub listView1_DblClick()
On Error GoTo ErrPesan
Dim i As Integer
Dim TempIndex As Integer
Dim strSQL As String
Dim tempKode, tempstatus As String
If listView1.ListItems.Count = 0 Then Exit Sub
If listView1.SelectedItem Is Nothing Then Exit Sub
set con = New ADODB.Connection
TempIndex = listView1.SelectedItem.Index
tempKode = listView1.SelectedItem
' Sory disini object rsfilm masih belom jelas dimana posisi kursornya
jadi anda harus memastikan bahwa rsfilm berada pada posisi yang benar
sehingga anda tidak dapat membuat statement apakah status ada.
Sebaiknya anda coba ambil data status dari
listview1.selecteditem.subitem(?) dimana sub item status tersebut ada.
'asumsi bahwa kolom status berada pada subitem 3
if listview1.SelectedItem.SubItem(3) = "ADA" Then
jawab = MsgBox("Apakah Anda yakin Data " & kode_film & _
vbCrLf & " Akan dihapus ? ", vbInformation + vbYesNo)
If jawab = vbYes Then
con.CursorLocation = adUseServer
con.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & _
App.Path & "\rental1.mdb"
strSQL = "DELETE * FROM film where kode_film = '" & tempKode & "'"
con.BeginTrans
con.Execute strSQL
con.CommitTrans
listView1.ListItems.Remove TempIndex
MsgBox "DATA FILM TELAH DIHAPUS"
set con = Nothing
End If
Else
MsgBox "Data belum bisa dihapus " & vbCrLf & " Film Masih diPinjam", vbInformation
End If
Exit Sub
ErrPesan:
If con.State = adStateOpen Then
con.RollBackTrans
set con = nothing
End If
MsgBox "Error !!! " & vbCrLf & Err.Description, vbExclamation
End Sub
Note:
BeginTrans
The BeginTrans method starts a new transaction.
This method can also be used to return a long value that is the level
of nested transactions. A top level transaction has a return value of
1. Each additional level increments by one.
CommitTrans
The CommitTrans method saves all changes made since the last
BeginTrans method call, and ends the current transaction.
Since transactions can be nested, all lower-level transactions must be
resolved before you can resolve higher-level transactions.
RollbackTrans
The RollbackTrans method cancels all changes made since the last
BeginTrans method call, and ends the transaction.
Since transactions can be nested, all lower-level transactions must be
resolved before you can resolve higher-level transactions.
Ok semoga dengan sedikit Script diatas dapat membatu anda
Terima Kasih dan Selamat Mencoba
Salam,
Aiska Hendra
Subscribe to:
Post Comments (Atom)
Untuk memampilkan data grid pada file yang lain bagaimana? Apakah rumus ini sudab benar?
Private Sub cmdOK_Click()
Dim totalItem As Integer
Dim totalHarga As Currency
Dim rsPenjualan As New ADODB.Recordset
rsPenjualan.CursorLocation = adUseClient
rsPenjualan.Open "PENJUALAN", con, adOpenDynamic, adLockOptimistic
Dim rsDetail As New ADODB.Recordset
rsDetailPenjualan.CursorLocation = adUseClient
rsDetailPenjualan.Open "PENJUALAN_DETAIL", con, adOpenDynamic, adLockOptimistic
rsDetailPenjualan.MoveFirst
On Error GoTo Hell
con.BeginTrans
rsPenjualan.AddNew
rsPenjualan("kodePenjualan") = txtKodePenjualan.Text
rsPenjualan("kodeCustomer") = kodeCustomer
rsPenjualan("tanggalPenjualan") = tanggalPenjualan
rsPenjualan.Update
While Not rsDetailPenjualan.EOF
rsDetailPenjualan.AddNew
rsDetailPenjualan("kodePenjualan") = rsDetailPenjualan("kodePenjualan")
rsDetailPenjualan("kodeBarang") = rsDetailPenjualan("kodeBarang")
rsDetailPenjualan("jumlahBarang") = rsDetailPenjualan("jumlahBarang")
rsDetailPenjualan("hargaBarang") = rsDetailPenjualan("hargaBarang")
rsDetailPenjualan.Update
totalItem = totalItem + Val(rsDetailPenjualan("jumlahBarang"))
totalHarga = totalHarga + CCur(rsDetailPenjualan("hargaBarang"))
rsDetailPenjualan.MoveNext
Wend
rsPenjualan("totalItemPenjualan") = totalItem
rsPenjualan("totalHargaPenjualan") = totalHarga
rsPenjualan.Update
con.CommitTrans
GoTo Heaven
Hell:
con.RollbackTrans
MsgBox ("Data Gagal Dimasukkan.")
GoTo Heaven
Heaven:
con.Close
Unload Me
End Sub