[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間: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