List 7-75　FormProductフォームのBTN_DELETE_Clickプロシージャ

---

  1： Private Sub BTN_DELETE_Click()
  2：     ' ［削除］ボタンが押されたときの処理
  3：     Dim objProduct As Business.Product
  4：     Dim DeletedFlag As Boolean
  5：     Dim beforeProductID As Long, PRODUCTID As Long
  6：     
  7：     ' 削除の確認
  8：     If MsgBox(g_objRec.Fields("PRODUCTNAME").Value & _
   　                               "を削除してよろしいですか", vbYesNo, _
   　                               "削除の確認") = vbYes Then
  9：         
 10：         ' 現在のDELETEDFLAGフィールドの値を取得する
 11：         DeletedFlag = g_objRec.Fields("DELETEDFLAG").Value
 12：         ' 現在のIDフィールドの値を取得する
 13：         PRODUCTID = g_objRec.Fields("ID").Value
 14：         
 15：         On Error Resume Next
 16：         ' 削除後にカレント行に設定したい行のIDフィールドの値を保存しておく
 17：         If (g_uRole And (ROLE_ALLADMIN Or ROLE_PRODUCTSADMIN)) And _
   　             (DeletedFlag = False) Then
 18：             ' AllAdminロールまたはProductsAdminロールに属していて，
 19：             ' かつ，削除対象となったレコードのDELETEDFLAGフィールドの値が
 20：             ' Falseであった場合には，現在のカレント行のIDフィールドの値を記録する
 21：             beforeProductID = PRODUCTID
 22：         Else
 23：             ' そうでなければ現在よりもひとつうしろのIDフィールドの値を記録する
 24：             g_objRec.MoveNext
 25：             beforeProductID = g_objRec.Fields("ID").Value
 26：         End If
 27：         
 28：         If Err.NUMBER <> 0 Then
 29：             beforeProductID = -1
 30：             Err.Clear
 31：         End If
 32：         
 33：         On Error GoTo ErrHandle
 34：         ' 削除する
 35：         Set objProduct = CreateObject("Business.Product")
 36：         objProduct.DeleteProduct PRODUCTID
 37：         
 38：         ' データグリッドの表示を更新
 39：         RefreshData
 40：         
 41：         On Error Resume Next
 42：         ' カレント行を移動する
 43：         g_objRec.MoveFirst
 44：         g_objRec.Find "ID=" & beforeProductID, 0, adSearchForward
 45：         
 46：         Set objProduct = Nothing
 47：     End If
 48：     
 49：     Exit Sub
 50：     
 51： ErrHandle:
 52：     ' ビジネスオブジェクトの呼び出しに失敗
 53：     MsgBox Err.Description, vbOKOnly, "製品の削除"
 54：     Set objProduct = Nothing
 55： End Sub