List 7-94　FormEditStockフォームのFillComboプロシージャ

---

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