- 日時： 2008/01/14 10:26
- 名前： BBKING
- 今このコードがエラーが出ってどうしても分からないから教えてください。
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
cmdNext.Enabled = True
cmdLast.Enabled = True
End Sub
実行時エラー’-2147467259(8004005)'
更新に必要なベーステーブル情報がたりません。
というエラーメセッジがでる。
VB6.0
XP SP1
念のため全部添付しましたので
よろしくお願いします。
Option Explicit
Private cn As New ADODB.Connection
Private Sub cmdFirst_Click()
deMain.rscmdMaster.MoveFirst
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 cmdNext_Click()
deMain.rscmdMaster.MoveNext
If deMain.rscmdMaster.EOF Then
deMain.rscmdMaster.MoveLast
End If
Call RefreshData
Call CalcTotal
End Sub
Private Sub cmdLast_Click()
deMain.rscmdMaster.MoveLast
Call RefreshData
Call CalcTotal
End Sub
Private Sub mnuFileQuit_Click()
Unload Me
End Sub
Private Sub RefreshData()
Dim rs As New ADODB.Recordset 'Recordsetオブジェクト
Dim mySQL As String 'SQLステートメント
'SQLステートメント
mySQL = "SELECT 伝票番号,伝票サブ.商品ID, 商品名, 単価, 数量, " _
& "単価 * 数量 AS 金額 " _
& "FROM 伝票サブ INNER JOIN 商品一覧 " _
& "ON 伝票サブ.商品ID = 商品一覧.商品ID " _
& "WHERE 伝票番号 = " & txt伝票番号.Text
'レコードセットを取得
rs.Open mySQL, cn, adOpenStatic, adLockOptimistic
Set dbgSub.DataSource = rs
'フォーマット
dbgSub.Columns("伝票番号").Visible = False
dbgSub.Columns("商品ID").Width = 60 * 15 '900twip
dbgSub.Columns("商品名").Width = 150 * 15 '2250twip
dbgSub.Columns("単価").Width = 60 * 15 '900twip
dbgSub.Columns("数量").Width = 60 * 15 '900twip
dbgSub.Columns("金額").Width = 60 * 15 '900twip
End Sub
Private Sub Form_Load()
Dim dbname As String 'データベース名
dbname = GetDataSource()
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
& "Data Source=" & dbname
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 Function GetDataSource() As String
Dim startPos As Long '開始位置
Dim endPos As Long '終了位置
Dim skip As Long '読み飛ばす文字数
'データソースの取得
startPos = InStr(1, deMain.cnSales.ConnectionString, _
"Data Source=", vbTextCompare)
endPos = InStr(startPos, deMain.cnSales.ConnectionString, _
";", vbTextCompare)
skip = Len("Data Source=")
GetDataSource = Mid(deMain.cnSales.ConnectionString, _
startPos + skip, endPos - (startPos + skip))
End Function
Private Sub dbgSub_OnAddNew()
dbgSub.Columns("伝票番号").Value = txt伝票番号.Text
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set cn = Nothing
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 cmdSubDelete_Click()
Dim rs As New ADODB.Recordset 'Recordsetオブジェクト
Dim ret As Integer 'MsgBox関数の戻り値
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 cmdAdd_Click()
Dim rs As New ADODB.Recordset '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 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
cmdNext.Enabled = True
cmdLast.Enabled = True
End Sub
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 'Recordsetオブジェクト
Dim ret As Integer 'MsgBox関数の戻り値
Beep
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
txt合計.Text = ""
End If
Case vbNo
'
End Select
End Sub
Private Sub CalcTotal()
Dim rs As New ADODB.Recordset '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)
Select Case ColIndex
Case 1, 4
Call CalcTotal
Case Else
'
End Select
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 mnuEditFind_Click()
Dim denNo As String '検索する値
Dim bmark As Variant 'ブックマーク
Dim ret As Integer 'MsgBox関数の戻り値
'ブックマークを保持
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
Beep
ret = MsgBox("該当する伝票が見つかりません。", _
vbOKOnly, "伝票検索")
deMain.rscmdMaster.Bookmark = bmark
'見つかったとき
Else
Call RefreshData
Call CalcTotal
End If
End Sub
Private Sub mnuOptionExport_Click()
On Error GoTo Err_mnuOptionExport_Click
Dim ret As Integer 'MsgBox関数の戻り値
'[保存]ダイアログ ボックス
dlgSave.InitDir = App.Path
dlgSave.ShowSave
'CSV形式で出力
With 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
'終了
Beep
ret = MsgBox("エクスポートを終了しました", _
vbOKOnly, "エクスポート")
Err_mnuOptionExport_Click:
End Sub
 |
このスレッドはロックされています。記事の閲覧のみとなります。
Re: エラーの原因は