【Access VBA】効率よく伝票フォームに入力する方法(後編)

Private Sub 明細追加_Click()

Dim stSQL As String
Dim SUBId As Long '部品登録ID
Dim SUBNm As String '品名
Dim SUBTp As String '型式
Dim SUBPc As Long '単価
Dim SUBCnt As Integer '個数
Dim SUBIpt As Variant 'INPUTBOX
Dim MAINTm As Long '発注金額

Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQL As String

'伝票明細テーブルに追記する型式などを選定
SUBId = Me.F01部品マスタ明細追加DS!部品登録ID.Value
SUBNm = Me.F01部品マスタ明細追加DS!品名.Value
SUBPc = Me.F01部品マスタ明細追加DS!価格.Value
Select Case Me.F01部品マスタ明細追加DS!伝票表示.Value
    Case "型式"
        SUBTp = Me.F01部品マスタ明細追加DS!型式.Value
    Case "規格"
        SUBTp = Me.F01部品マスタ明細追加DS!規格.Value
    Case "サイズ"
        SUBTp = Me.F01部品マスタ明細追加DS!サイズ.Value
End Select

'個数入力用InputBoxの起動
SUBIpt = InputBox(Prompt:="何個購入しますか？", Title:="個数の入力", Default:=1)

If SUBIpt = "" Or IsNumeric(SUBIpt) = False Then
    Exit Sub
End If
    DoCmd.SetWarnings False
        '明細テーブルへのデータ追加
        stSQL = "INSERT INTO T02発注伝票明細 (発注登録No,枝番,部品登録ID,品名,規格,単価,数量,大分類名,中分類名,小分類名)" & _
        " VALUES (" & Me.発注登録No受渡用.Value & "," & Me.枝番受渡用.Value & "," & SUBId & ",'" & SUBNm & "','" & SUBTp & "'," & _
        SUBPc & "," & CInt(SUBIpt) & ",'" & Me.F01部品マスタ明細追加DS!大分類名.Value & "','" & Me.F01部品マスタ明細追加DS!中分類名.Value & _
        "','" & Me.F01部品マスタ明細追加DS!小分類名.Value & "');"
        DoCmd.RunSQL stSQL
        'ADO接続で合計金額を計算
        Set CN = CurrentProject.Connection
            Set RS = New ADODB.Recordset
            SQL = "SELECT Sum(金額) AS 金額計 FROM Q02発注伝票明細表示用 GROUP BY 発注登録No HAVING 発注登録No=" & Me.発注登録No受渡用.Value & ";"
            RS.open SQL, CN, adOpenKeyset, adLockOptimistic
            '合計金額を変数に入れる
            MAINTm = RS!金額計
        RS.Close:  Set RS = Nothing
        CN.Close:  Set CN = Nothing
        '伝票テーブルの総金額と件数を更新
        stSQL = "UPDATE T02発注伝票 SET 発注金額 =" & MAINTm & ", 明細件数 =" & Me.枝番受渡用.Value & " WHERE 発注登録No = " & Me.発注登録No受渡用.Value & ";"
        DoCmd.RunSQL stSQL
        '伝票フォームへのデータ反映と追加フォームを閉じる処理
        DoCmd.Close acForm, "F02発注伝票T"
        DoCmd.OpenForm "F02発注伝票T", acNormal, , "発注登録No=" & Me.発注登録No受渡用.Value, acFormEdit
        DoCmd.Close acForm, Me.Name
    DoCmd.SetWarnings True
End Sub

Private Sub 総計算出_Click()

Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQL As String
Dim stSQL As String

Dim MAINTm As Long '発注金額

    DoCmd.SetWarnings False
        'ADO接続で合計金額を計算
        Set CN = CurrentProject.Connection
            Set RS = New ADODB.Recordset
            SQL = "SELECT Sum(金額) AS 金額計 FROM Q02発注伝票明細表示用 GROUP BY 発注登録No HAVING 発注登録No=" & 発注登録No.Value & ";"
            RS.open SQL, CN, adOpenKeyset, adLockOptimistic
            MAINTm = RS!金額計
        RS.Close:  Set RS = Nothing
        CN.Close:  Set CN = Nothing
               
        '合計金額の更新
        stSQL = "Update T02発注伝票 SET 発注金額 =" & MAINTm & " Where 発注登録No = " & Me.発注登録No.Value & ";"
        DoCmd.RunSQL stSQL
    DoCmd.SetWarnings True
    Me.Recalc
End Sub