お弁当注文システムを作る　～その２～

Sub　inport() 
　　ActiveWorkbook.Connections("クエリ - フォームの回答 1").Refresh 
End　sub

Sub DBrenew()
'注文DBの更新
    Dim n As Integer, m As Integer    
    Dim e As Date, x As Integer, y As String, z As Integer, v As String   'e＝年月日時分秒,x＝社員番号,y＝氏名,z＝数量,v=弁当
    m = Worksheets("inport").Cells(Rows.Count, 1).End(xlUp).Row
    For n = 2 To m
        e = Worksheets("inport").Cells(n, 1)  '年月日時分秒
        x = Worksheets("inport").Cells(n, 2)  '社員番号
        y = Worksheets("inport").Cells(n, 3)  '氏名
        v = Worksheets("inport").Cells(n, 4)  '弁当
        z = Worksheets("inport").Cells(n, 5)  '数量
        
        Dim foundcell As Range, firstcell As Range, targetcell As Range
        
        Set foundcell = Worksheets("DB").Range("b:b").Find(e)
        If Not foundcell Is Nothing Then        
            Set firstcell = foundcell        
            If foundcell.Offset(0, 2) = x Then
                GoTo 100
            Else
                Do
                    Set foundcell = Worksheets("DB").Range("b:b").FindNext(foundcell)
                        If foundcell.Address = firstcell.Address Then
                            Exit Do
                        End If                    
                        If foundcell.Offset(0, 2) = x Then
                            GoTo 100
                        End If
                Loop
             End If
        End If
  
        Dim o As Integer
        o = Worksheets("DB").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Worksheets("DB").Cells(o, 1) = 1  '区分
        Worksheets("DB").Cells(o, 2) = e  '年月日時分秒
        Worksheets("DB").Cells(o, 3) = o  '管理№
        Worksheets("DB").Cells(o, 4) = x  '社員番号
        Worksheets("DB").Cells(o, 5) = y  '氏名
        Worksheets("DB").Cells(o, 6) = v  'お弁当
        Worksheets("DB").Cells(o, 7) = z  '数量            
100
    Next n
End Sub

Sub orderlist()
    Worksheets("orderlist").Activate
    Dim a As Long
    a = Worksheets("orderlist").Cells(Rows.Count, 1).End(xlUp).Row
    If a <> 2 Then
        Worksheets("orderlist").Range("a3:e" & a).Select
        Selection.ClearContents
        Selection.Borders.LineStyle = xlLineStyleNone
    End If

    Dim d As Date     '　d　＝今日の日付
    d = Date
    Dim n As Integer, m As Integer
    Dim e As Date, f As Date
    Dim p As Integer
    m = Worksheets("DB").Cells(Rows.Count, 2).End(xlUp).Row
    For n = 2 To m
        If Worksheets("DB").Cells(n, 1) <> 0 Then
            e = Worksheets("DB").Cells(n, 2)
            f = DateSerial(Year(e), Month(e), Day(e))
            If f = d Then
                Dim o As Integer
                o = Worksheets("orderlist").Cells(Rows.Count, 1).End(xlUp).Row + 1
                p = p + 1
                Worksheets("orderlist").Cells(o, 1) = p        '№
                Worksheets("orderlist").Cells(o, 2) = Worksheets("DB").Cells(n, 3)  '管理№
                Worksheets("orderlist").Cells(o, 3) = Worksheets("DB").Cells(n, 5)  '氏名
                Worksheets("orderlist").Cells(o, 4) = Worksheets("DB").Cells(n, 6)  'お弁当
                Worksheets("orderlist").Cells(o, 5) = Worksheets("DB").Cells(n, 7)  '数量
            End If
        End If
    Next n
    
    Worksheets("orderlist").Cells(1, 1) = Month(d) & "月" & Day(d) & "日　お弁当注文者リスト"

    a = Worksheets("orderlist").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("orderlist").Range("a2:e" & a).Borders.LineStyle = xlContinuous
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim cmdBar1 As CommandBarControl
    For Each cmdBar1 In Application.CommandBars("cell").Controls
        If cmdBar1.Caption = "注文のキャンセル" Then
            cmdBar1.Delete
        End If
    Next    
    With Application.CommandBars("cell").Controls.Add
        .Caption = "注文のキャンセル"
        .OnAction = "ordercancel"
    End With
End Sub


Private Sub Worksheet_Deactivate()
    Dim cmdBar1 As CommandBarControl
    For Each cmdBar1 In Application.CommandBars("cell").Controls
        If cmdBar1.Caption = "注文のキャンセル" Then
            cmdBar1.Delete
        End If
    Next
End Sub

Sub ordercancel()
　　Dim　n as integer,t As String,o as long
    n = ActiveCell.Row
    t = Worksheets("orderlist").Cells(n, 3)　　‘オーダーをキャンセルする者の氏名
    o = Worksheets("orderlist").Cells(n, 2)　　‘キャンセルするオーダーの管理№
    Set rcd = Worksheets("DB").Range("c:c").Find(o, lookat:=xlWhole)
    If Worksheets("orderlist").Cells(n, 1).Value = "" Then
        MsgBox "キャンセルする行を指定してください"
    Else
        rtn = MsgBox(t & "さんのオーダーをキャンセルしますか", vbYesNo + vbQuestion + vbDefaultButton2, "確認")
        Select Case rtn  '押されたボタンの確認
            Case vbYes
                rcd.Offset(0, -2) = 0
                Call Module1.orderlist
            Case vbNo
        End Select
    End If    
End Sub

Sub 発注書()
    Worksheets("発注書").Activate
        Set rcd = Worksheets("発注書").Range("b:b").Find("計")
        r = rcd.Row - 1
        If r <> 10 Then
            Worksheets("発注書").Range("b11:b" & r).EntireRow.Delete
        End If

    Dim d As Date     '　d　＝今日の日付
    d = Date
    Worksheets("発注書").Cells(1, 5) = d

    Dim n As Integer, m As Integer, x As Integer, e As Date, f As Date    
    m = Worksheets("DB").Cells(Rows.Count, 1).End(xlUp).Row
    x = 0
    For n = 2 To m
        e = Worksheets("DB").Cells(n, 2)
        f = DateSerial(Year(e), Month(e), Day(e))
        If f = d Then
            If Worksheets("DB").Cells(n, 1) = 1 Then
                v = Worksheets("DB").Cells(n, 6)
                Set rcd2 = Worksheets("発注書").Range("b:b").Find(v)
                    If rcd2 Is Nothing Then
                        Set rcd = Worksheets("発注書").Range("b:b").Find("計")
                        rcd.EntireRow.Insert
                        rcd.Offset(-1, 0) = v
                        rcd.Offset(-1, 1) = Worksheets("DB").Cells(n, 7)
                        Set rcd3 = Worksheets("マスター").Range("a:a").Find(v)
                        If rcd3 Is Nothing Then
                            MsgBox "マスターにメニューを登録してください"
                            Exit Sub
                        End If
                        rcd.Offset(-1, 2) = rcd.Offset(-1, 1) * rcd3.Offset(0, 1)
                    Else
                        rcd2.Offset(0, 1) = rcd2.Offset(0, 1) + Worksheets("DB").Cells(n, 7)
                        Set rcd3 = Worksheets("マスター").Range("a:a").Find(v)
                        rcd2.Offset(0, 2) = rcd2.Offset(0, 1) * rcd3.Offset(0, 1)
                    End If
            End If
        End If
    Next n
    
    Set rcd = Worksheets("発注書").Range("b:b").Find("計")
    r = rcd.Row - 1
    For n = 11 To r
        su = su + Worksheets("発注書").Cells(n, 3)
        ki = ki + Worksheets("発注書").Cells(n, 4)
    Next n
    Worksheets("発注書").Cells(r + 1, 3) = su
    Worksheets("発注書").Cells(r + 1, 4) = ki
End Sub