List 7-156　FormEditSlipDetailフォームのFillComboプロシージャ

---

  1： Private g_objRec As ADODB.Recordset
  2： 
  3： Private Sub FillCombo(SetFocusID As Long)
  4：     ' 製品名を格納するCOMBO_PRODUCTコンボボックスに
  5：     ' 現在登録されている製品一覧を登録する
  6：     ' 【引数】
  7：     '   SetFocusID = コンボボックスに入れたあと，この引数に指定した
  8：     '                レコードIDを持つものが選択状態になる
  9：     ' 【戻り値】
 10：     '   なし
 11：     Dim objProduct As Business.Product
 12：     Dim SelIndex As Long
 13：     
 14：     ' 製品名の一覧を得る
 15：     On Error GoTo ErrHandle
 16：     
 17：     Set objProduct = CreateObject("Business.Product")
 18：     Set g_objRec = objProduct.GetProducts()
 19：     
 20：     ' 取得した製品名の一覧をコンボボックスに加える
 21：     COMBO_PRODUCT.Clear
 22：     
 23：     SelIndex = -1
 24：     While Not g_objRec.EOF
 25：         If g_objRec.Fields("DELETEDFLAG").Value = False Then
 26：             ' 削除ずみでなければコンボボックスに追加する
 27：             COMBO_PRODUCT.AddItem g_objRec.Fields("PRODUCTNAME").Value
 28：             COMBO_PRODUCT.ItemData(COMBO_PRODUCT.NewIndex) = g_objRec.Fields("ID").Value
 29：             
 30：             ' 引数に指定されたのと同じ製品番号があれば，そのインデックスを記録しておく
 31：             If g_objRec.Fields("ID").Value = SetFocusID Then
 32：                 SelIndex = COMBO_PRODUCT.NewIndex
 33：             End If
 34：         End If
 35：         g_objRec.MoveNext
 36：     Wend
 37：     
 38：     ' 引数で指定された製品番号を選択状態にする
 39：     COMBO_PRODUCT.listIndex = SelIndex
 40：     
 41：     Set objProduct = Nothing
 42：     
 43：     Exit Sub
 44： 
 45： ErrHandle:
 46：     ' エラーハンドラ
 47：     MsgBox Err.Description, vbOKOnly, "明細情報の編集エラー"
 48：     Set objProduct = Nothing
 49：     Set g_objRec = Nothing
 50： End Sub