投稿時間:2004/09/07(Tue) 14:52 投稿者名:阿呆宮
Eメール:kouichi_anazawa@nbs.nyk.jp
URL :
タイトル:オラクル参照とレコードセット
市販の参考書のサンプルプログラムを手入力し、実行させたが、うまくいきません。 オラクルDBより伝票マスタ、サブマスタ、商品一覧TBなどを結合させ、明細伝票の追加、削除 を、行うためのものですが、「商品ID」を入力しても「商品名」が表示されません。 再度、実行すると、手入力した商品IDも、商品名も表示されます。どうも、私のレコードセット の理解が不十分なため、対応ができない状態になっているようです。 どなたか、対処方法を、教えていただけませんでしょうか? ーーーーーーーーーーーーーーーーーーーーーーーーー Option Explicit Private cn As New ADODB.Connection Private Sub cmdCancel_Click() deMain.rscmdMaster.CancelUpdate
If deMain.rscmdMaster.RecordCount <> 0 Then
Call Refreshdata
Call CALCTOTAL dbgsub.Visible = True
cmdFirst.Enabled = True cmdPrevious.Enabled = True cmdNext.Enabled = True cmdLast.Enabled = True cmdDelete.Enabled = True
Else 'レコード移動ボタン cmdFirst.Enabled = False cmdPrevious.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False cmdDelete.Enabled = False End If
cmdAdd.Enabled = True cmdCancel.Enabled = False cmdUpdate.Enabled = False
End Sub
Private Sub cmdDelete_Click() Dim rs As New ADODB.Recordset Dim ret As Integer
ret = MsgBox("表示中の伝票を削除します、いいですか", _ vbYesNo + vbQuestion + vbDefaultButton2, _ "伝票削除") Select Case ret Case vbYes 'はい 'マスター削除 deMain.rscmdMaster.Delete '詳細削除 Set rs = dbgsub.DataSource If rs.RecordCount <> 0 Then rs.MoveFirst Do Until rs.EOF rs.Delete rs.MoveNext Loop End If
'カレントレコード設定 'レコードがあるとき If deMain.rscmdMaster.RecordCount <> 0 Then deMain.rscmdMaster.MovePrevious If deMain.rscmdMaster.BOF Then deMain.rscmdMaster.MoveFirst End If Call Refreshdata
Call CALCTOTAL 'レコードがないとき Else cmdFirst.Enabled = False cmdPrevious.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False cmdDelete.Enabled = False cmdAdd.SetFocus deMain.rscmdMaster.AddNew deMain.rscmdMaster.CancelUpdate dbgsub.Visible = False End If
Case vbNo End Select
End Sub
Private Sub cmdSubDelete_Click() Dim rs As New ADODB.Recordset Dim ret As Integer ret = MsgBox("選択中のレコードを削除しますか", _ vbYesNo + vbQuestion + vbDefaultButton2, _ "削除情報") Select Case ret Case vbYes Set rs = dbgsub.DataSource rs.Delete Call Refreshdata Call CALCTOTAL cmdSubDelete.Enabled = False
Case vbNo End Select
End Sub
Private Sub cmdUpdate_Click() deMain.rscmdMaster.Update dbgsub.Visible = True '追加操作関連ボタン cmdAdd.Enabled = True cmdUpdate.Enabled = False cmdCancel.Enabled = False
cmdDelete.Enabled = True
'レコード移動ボタン cmdFirst.Enabled = True cmdPrevious.Enabled = True cmdLast.Enabled = True
End Sub
Private Sub dbgsub_Change() dbgsub.Columns("伝票番号").Value = txt伝票番号.Text
End Sub
Private Sub form_load() Dim dbname As String
'dbname = GetDataSource()
cn.ConnectionString = "provider=MSDAORA;USER ID=NASDB;" _ & "PASSWORD=KING; data source=QJ1SV05"
cn.Open If deMain.rscmdMaster.RecordCount <> 0 Then Call Refreshdata Call CALCTOTAL cmdFirst.Enabled = True cmdPrevious.Enabled = True cmdNext.Enabled = True cmdLast.Enabled = True cmdDelete.Enabled = True Else dbgsub.Visible = False cmdFirst.Enabled = False cmdPrevious.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False cmdDelete.Enabled = False End If
cmdAdd.Enabled = True cmdUpdate.Enabled = False cmdCancel.Enabled = False
cmdSubDelete.Enabled = False End Sub
Private Sub Refreshdata() Dim rs As New ADODB.Recordset 'record set onject Dim mySQL As String ' --------------------------------------------- Set rs = New ADODB.Recordset ' ******test rs.CursorLocation = adUseClient ' ******test ' -------------------------------------------- mySQL = "SELECT 伝票番号,伝票サブ.商品ID,商品名,単価,数量, " _ & "単価 * 数量 AS 金額 " _ & "FROM 伝票サブ,商品一覧 " _ & "WHERE 伝票サブ.商品ID = 商品一覧.商品ID " _ & "AND 伝票番号 = " & txt伝票番号.Text 'レコードセットを取得 rs.Open mySQL, cn, adOpenStatic, adLockOptimistic
Set dbgsub.DataSource = rs
dbgsub.Columns("伝票番号").Visible = False dbgsub.Columns("商品ID").Width = 60 * 15 dbgsub.Columns("商品名").Width = 150 * 15 dbgsub.Columns("単価").Width = 60 * 15 dbgsub.Columns("数量").Width = 60 * 15 dbgsub.Columns("金額").Width = 60 * 15
End Sub Private Sub cmdFirst_Click() deMain.rscmdMaster.MoveFirst
Call Refreshdata Call CALCTOTAL
End Sub
Private Sub cmdLast_Click() deMain.rscmdMaster.MoveLast
Call Refreshdata Call CALCTOTAL End Sub
Private Sub cmdNext_Click() deMain.rscmdMaster.MoveNext If deMain.rscmdMaster.EOF Then deMain.rscmdMaster.MoveLast End If Call Refreshdata Call CALCTOTAL End Sub
Private Sub cmdPrevious_Click() deMain.rscmdMaster.MovePrevious If deMain.rscmdMaster.BOF Then deMain.rscmdMaster.MoveFirst End If Call Refreshdata Call CALCTOTAL End Sub
Private Sub mnuEditFind_Click() Dim denNo As String Dim bmark As Variant Dim ret As Integer 'ブックマークを保持 bmark = deMain.rscmdMaster.Bookmark denNo = InputBox("伝票番号を入力してください", "伝票検索") If denNo = "" Then Exit Sub End If '検索 deMain.rscmdMaster.MoveFirst deMain.rscmdMaster.Find "伝票番号 =" & CLng(denNo) '見つからなかったとき If deMain.rscmdMaster.EOF Then ret = MsgBox("該当する伝票が見つかりません。", vbOKOnly, "伝票検索") deMain.rscmdMaster.Bookmark = bmark '見つかったとき Else Call Refreshdata Call CALCTOTAL End If End Sub
Private Sub mnuFilePrint_Click() deMain.Commands("rptMaster").Parameters("prmNo") = txt伝票番号.Text 'プレビュー画面の大きさ drDenpyo.Width = 900 * 15 drDenpyo.Height = 600 * 15 'プレビュー表示 drDenpyo.Show End Sub
Private Sub mnuFileQuit_Click() Unload Me End Sub
Private Sub form_unload(cancel As Integer) Set cn = Nothing End Sub Private Sub dbgsub_OnAddNew() dbgsub.Columns("伝票番号").Value = txt伝票番号.Text
End Sub Private Sub dbgsub_click() If dbgsub.SelBookmarks.Count = 0 Then cmdSubDelete.Enabled = False Else cmdSubDelete.Enabled = True End If
End Sub Private Sub CALCTOTAL() Dim rs As New ADODB.Recordset Dim TOTAL As Long Dim bmark As Variant TOTAL = 0 Set rs = dbgsub.DataSource
'新しいデータ If IsNull(rs!数量) Then Exit Sub End If
If rs.RecordCount <> 0 Then bmark = dbgsub.Bookmark rs.MoveFirst End If '合計金額
Do Until rs.EOF TOTAL = TOTAL + rs!金額 rs.MoveNext Loop TXT合計.Text = CStr(Format(TOTAL, "#,##0")) 'もとのレコードへ If bmark <> Null Then dbgsub.Bookmark = bmark Else If rs.RecordCount <> 0 Then rs.MoveLast End If End If
End Sub Private Sub dbgsub_AfterColEdit(ByVal ColIndex As Integer) dbgsub.Columns("伝票番号").Value = txt伝票番号.Text ' ------------------------TEMPOLARY START 1-----------------------------
' ------------------------TEMPOLARY END 1 ------------------------ Select Case ColIndex Case 1 Call CALCTOTAL Case 4 Call CALCTOTAL Case Else End Select ' ---------------------------- TEMPOLARY INPUT START2 -----------
End Sub Private Sub cmdAdd_Click() Dim rs As New ADODB.Recordset Dim denNo As Long 'レコードが存在しないとき If deMain.rscmdMaster.RecordCount = 0 Then denNo = 0 'レコードが存在するとき Else Set rs = deMain.rscmdMaster rs.Sort = "伝票番号 ASC" rs.MoveLast denNo = rs!伝票番号 Set rs = Nothing End If '伝票を追加 deMain.rscmdMaster.AddNew txt伝票番号.Text = denNo + 1 txt日付.Text = Date txt日付.SetFocus Call Refreshdata Call CALCTOTAL dbgsub.Visible = False 'コントロールの設定 cmdAdd.Enabled = False cmdUpdate.Enabled = True cmdCancel.Enabled = True cmdDelete.Enabled = False
cmdFirst.Enabled = False cmdPrevious.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False
End Sub
Private Sub mnuOptionExport_Click() On Error GoTo ERR_MNUOPTIONEXPORT_CLICK Dim ret As Integer '保存ダイアログボックス dlgSave.InitDir = App.Path dlgSave.ShowSave 'csv形式で出力 With deMain.rscmdExport deMain.rscmdExport.Open Open dlgSave.FileName For Output As #1 'タイトル Write #1, "顧客ID", "顧客名", "郵便番号", "都道府県", "住所", "郵便番号" 'データ .MoveFirst Do Until .EOF Write #1, !顧客ID, !顧客名, !郵便番号, !都道府県, !住所, !電話番号 .MoveNext Loop Close #1 .Close End With '終了 ret = MsgBox("エクスポート終了しました", vbOKOnly, "エクスポート") ERR_MNUOPTIONEXPORT_CLICK: End Sub
|