'mdb立上の為のAPI
Private Declare Function ShellExecute Lib _
      "shell32.dll" Alias "ShellExecuteA" _
      (ByVal hWnd As Long, _
      ByVal lpOperation As String, _
      ByVal lpFile As String, _
      ByVal lpParameters As String, _
      ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long

'/////////////////////////////////////////////////
'子Com_move1
'/////////////////////////////////////////////////
Private Sub Com_move1_Click(Index As Integer)
    If Index = 0 Then
        If Me.Adodc1.Recordset.BOF Then
          MsgBox "これより前にレコードは存在しません。"
        Else
          Me.Adodc1.Recordset.MovePrevious
            If Me.Adodc1.Recordset.BOF Then
             MsgBox "これより前にレコードは存在しません。"
             Me.Adodc1.Recordset.MoveNext
            Else
             '??????????????????????????????????
                '伝票親
                For CNT = 0 To 10
                  If IsNull(Me.Adodc1.Recordset.Fields(CNT).Value) = False Then
                    txt(CNT).Text = Me.Adodc1.Recordset.Fields(CNT).Value
                  Else
                    txt(CNT).Text = ""
                  End If
                Next CNT
                '伝票子
                SQL = "select * from 伝票子 where 削除 = 0 and NO = " & Trim(txt(0).Text)
                Me.Adodc2.RecordSource = SQL
                Me.Adodc2.Refresh
                Call DG_Width
                '経費
                SQL = "select * from 経費 where 削除 = 0 and NO = " & Trim(txt(0).Text)
                Me.Adodc3.RecordSource = SQL
                Me.Adodc3.Refresh
                Call DG2_Width
                Me.txtkei(0).Text = ""
                Me.txtkei(1).Text = ""
                Me.txtkei(2).Text = ""
                Me.txtkei(3).Text = ""
            End If
        End If
    ElseIf Index = 1 Then
        If Me.Adodc1.Recordset.EOF Then
          MsgBox "これより後にレコードは存在しません。"
        Else
          Me.Adodc1.Recordset.MoveNext
          If Me.Adodc1.Recordset.EOF Then
            MsgBox "これより後にレコードは存在しません。"
            Me.Adodc1.Recordset.MovePrevious
          Else
             '??????????????????????????????????
                '伝票親
                For CNT = 0 To 10
                  If IsNull(Me.Adodc1.Recordset.Fields(CNT).Value) = False Then
                    txt(CNT).Text = Me.Adodc1.Recordset.Fields(CNT).Value
                  Else
                    txt(CNT).Text = ""
                  End If
                Next CNT
                '伝票子
                SQL = "select * from 伝票子 where 削除 = 0 and NO = " & Trim(txt(0).Text)
                Me.Adodc2.RecordSource = SQL
                Me.Adodc2.Refresh
                Call DG_Width
                '経費
                SQL = "select * from 経費 where 削除 = 0 and NO = " & Trim(txt(0).Text)
                Me.Adodc3.RecordSource = SQL
                Me.Adodc3.Refresh
                Call DG2_Width
                Me.txtkei(0).Text = ""
                Me.txtkei(1).Text = ""
                Me.txtkei(2).Text = ""
                Me.txtkei(3).Text = ""
          End If
        End If
    End If
End Sub

'/////////////////////////////////////////////////
'設定画面
'/////////////////////////////////////////////////
Private Sub Com_set_Click()
    Frm_set.Show
End Sub

'/////////////////////////////////////////////////
'親・新規登録
'/////////////////////////////////////////////////
Private Sub Com1_Click()
 If Trim(Me.Com1.Caption) = "新規" Then
  '下準備
    Me.Height = 2670
    Me.Com_move1(0).Enabled = False
    Me.Com_move1(1).Enabled = False
    Me.Com2.Enabled = False
    Me.lbl(11).Visible = False
    Me.Chk削除(11).Visible = False
    Me.Com1.Caption = "登録"
    'ここから登録準備(txtboxを空白に)
    For CNT = 0 To 10
      Me.txt(CNT).Text = ""
    Next CNT
    'ここから登録処理(NOの発番・記述日の取得から)
    SQL = "select NO from 伝票親 where 1=1 order by NO desc"
    Set REC = CNN.Execute(SQL)
    If REC.EOF = False Then
      Me.txt(0).Text = REC.Fields("NO").Value + 1
    Else
      Me.txt(0).Text = 1
    End If
    Set REC = Nothing
    Me.txt(1).Text = DateAdd("d", -1, CDate(Mid(Format(DateAdd("m", 1, Date), "yyyy/mm/dd"), 1, 8) & "01"))
    Me.txt(10).Text = Date
    Me.txt(2).SetFocus
 ElseIf Trim(Me.Com1.Caption) = "登録" Then
  '下準備
    Me.Height = 6000
    Me.Com_move1(0).Enabled = True
    Me.Com_move1(1).Enabled = True
    Me.Com2.Enabled = True
    Me.lbl(11).Visible = True
    Me.Chk削除(11).Visible = True
    Me.Com1.Caption = "新規"
    'ここから登録処理(NOの発番・記述日の取得から)
'    SQL = "select NO from 伝票親 where 1=1 order by NO desc"
'    Set REC = CNN.Execute(SQL)
'    If REC.EOF = False Then
'      Me.txt(0).Text = REC.Fields("NO").Value + 1
'    Else
'      Me.txt(0).Text = 1
'    End If
'    Set REC = Nothing
    '枝番発番
    SQL = "select NO from 伝票子 where NO = " & Me.txt(0).Text & " order by NO desc"
    Set REC = CNN.Execute(SQL)
    If REC.EOF = False Then
      Me.txtko(0).Text = REC.Fields("枝番").Value + 1
    Else
      Me.txtko(0).Text = 1
    End If
    Set REC = Nothing
    '記述日
    Me.txt(10).Text = Date
    '発番終わり(登録処理)
    SQL = "insert into 伝票親("
    For CNT = 0 To 10
      SQL = SQL & Trim(Me.lbl(CNT).Caption) & ","
    Next CNT
      SQL = SQL & "削除) values('"
    For CNT = 0 To 10
      SQL = SQL & Trim(Me.txt(CNT).Text) & "','"
    Next CNT
      SQL = SQL & Trim(Me.Chk削除(11).Value) & "')"
    Set REC = CNN.Execute(SQL)
    Set REC = Nothing
    Call データグリッド更新(Trim(Me.txt(0).Text))
    MsgBox "伝票親を新規登録を完了しました。"
    Me.txtko(1).SetFocus
 End If
End Sub

'/////////////////////////////////////////////////
'親・変更登録
'/////////////////////////////////////////////////
Private Sub Com2_Click()
'NOが空白の時の警告
If Len(Trim(Me.txt(0).Text)) = 0 Then
  MsgBox "検索を先に行ってください。"
  Exit Sub
End If
If MsgBox("伝票親を変更登録していいですか", vbYesNo + vbDefaultButton2, "親・変更登録") = vbNo Then Exit Sub
  Me.txt(10).Text = Date
  SQL = "update 伝票親 set "
    For CNT = 1 To 10   'NOは変更できないので１から始まる
      SQL = SQL & Trim(Me.lbl(CNT)) & " = '" & Trim(Me.txt(CNT).Text) & "', "
    Next CNT
      SQL = SQL & Trim(Me.lbl(11)) & " = '" & Trim(Me.Chk削除(11).Value) & "' "
  SQL = SQL & "Where NO = " & Trim(Me.txt(0).Text)
  Set REC = CNN.Execute(SQL)
  Set REC = Nothing
  MsgBox "原稿親を登録を完了しました。"
End Sub

'/////////////////////////////////////////////////
'子・新規登録
'/////////////////////////////////////////////////
Private Sub Com3_Click()
'NOが空白の時の警告
If Len(Trim(Me.txt(0).Text)) = 0 Then
  MsgBox "親データがありません。"
  Exit Sub
End If
  If MsgBox("伝票子を新規登録していいですか", vbYesNo + vbDefaultButton2, "子・新規登録") = vbNo Then Exit Sub
    '枝番発番
    SQL = "select * from 伝票子 where NO = " & Me.txt(0).Text & " order by 枝番 desc"
    Set REC = CNN.Execute(SQL)
    If REC.EOF = False Then
      Me.txtko(0).Text = REC.Fields("枝番").Value + 1
    Else
      Me.txtko(0).Text = 1
    End If
    Set REC = Nothing
  '伝票子登録
  SQL = "insert into 伝票子(NO,"
  For CNT = 0 To 7
    SQL = SQL & Me.lblko(CNT).Caption & ","
  Next CNT
    SQL = Mid(SQL, 1, Len(SQL) - 1) & ") values('" & Me.txt(0).Text & "','"
  For CNT = 0 To 5
    SQL = SQL & Me.txtko(CNT) & "','"
  Next CNT
    SQL = SQL & Me.chk税有無(6).Value & "','" & Me.Chk削除(7).Value & "')"
  Set REC = CNN.Execute(SQL)
  Set REC = Nothing
  MsgBox "原稿子に枝番" & Me.txtko(0).Text & " で登録を完了しました。"
  SQL = "select * from 伝票子 where NO = " & Me.txt(0).Text & " order by 枝番"
  Me.Adodc2.RecordSource = SQL
  Me.Adodc2.Refresh
  '小計・消費税・合計の計算
    LNG1 = 0
    LNG2 = 0
    LNG3 = 0
  Do Until Me.Adodc2.Recordset.EOF
      LNG1 = LNG1 + (Me.Adodc2.Recordset.Fields("金額").Value)                  '小計
    If Me.Adodc2.Recordset.Fields("税有").Value <> 0 Then
      LNG2 = LNG2 + (Me.Adodc2.Recordset.Fields("金額").Value * TAXRATE)        '消費税
      LNG3 = LNG3 + (Me.Adodc2.Recordset.Fields("金額").Value * (1 + TAXRATE))  '合計
    Else
      LNG3 = LNG3 + (Me.Adodc2.Recordset.Fields("金額").Value)                  '合計
    End If
    Me.Adodc2.Recordset.MoveNext
  Loop
  Me.txt(3).Text = LNG1
  Me.txt(4).Text = LNG2
  Me.txt(5).Text = LNG3
  Call Com2_Click
End Sub


'/////////////////////////////////////////////////
'コンボボックスの名前を請求先に
'/////////////////////////////////////////////////
Private Sub Com4_Click()
  Me.txt(2).Text = Me.Combo1.Text
End Sub

'/////////////////////////////////////////////////
'経費登録
'/////////////////////////////////////////////////
Private Sub Com5_Click()
'NOが空白の時の警告
If Len(Trim(Me.txt(0).Text)) = 0 Then
  MsgBox "親データがありません。"
  Exit Sub
End If
  If MsgBox("経費を新規登録していいですか", vbYesNo + vbDefaultButton2, "経費・新規登録") = vbNo Then Exit Sub
    '枝番発番
    SQL = "select * from 経費 where NO = " & Me.txt(0).Text & " order by 枝番 desc"
    Set REC = CNN.Execute(SQL)
    If REC.EOF = False Then
      Me.txtkei(3).Text = REC.Fields("枝番").Value + 1
    Else
      Me.txtkei(3).Text = 1
    End If
    Set REC = Nothing
  '経費登録
  SQL = "insert into 経費(NO,枝番,項目,金額,備考,削除) values('"
  SQL = SQL & Trim(Me.txt(0).Text) & "','" & Trim(Me.txtkei(3).Text) & "','" & Trim(Me.txtkei(0).Text) & "','" & Trim(Me.txtkei(1).Text) & "','" & Trim(Me.txtkei(2).Text) & "','0')"
  Set REC = CNN.Execute(SQL)
  Set REC = Nothing
  MsgBox "経費に枝番" & Me.txtkei(3).Text & " で登録を完了しました。"
  SQL = "select * from 経費 where NO = " & Me.txt(0).Text & " order by 枝番"
  Me.Adodc3.RecordSource = SQL
  Me.Adodc3.Refresh
  Me.txtkei(0).Text = ""
  Me.txtkei(1).Text = ""
  Me.txtkei(2).Text = ""
  Me.txtkei(3).Text = ""
End Sub

'/////////////////////////////////////////////////
'mdb立ち上げ
'/////////////////////////////////////////////////
Private Sub Command1_Click()
    'アクセスを直接立ち上げる
    iret = ShellExecute(Me.hWnd, vbNullString, App.Path & "\MM.mdb", vbNullString, "c:\", 1) 'SW_SHOWNORMAL)
    If iret <= 42 Then
        IL_View = True
    End If
End Sub

'/////////////////////////////////////////////////
'Form Laod
'/////////////////////////////////////////////////
Private Sub Form_Load()
  CNN.Open Provider
  Call setdata
  
  '過去の顧客リスト作成(ピンクのComboBox)
  SQL = "select distinct 請求先 from 伝票親 where 1=1"
  Set REC = CNN.Execute(SQL)
  If REC.EOF = False Then
    Do Until REC.EOF
      If IsNull(REC.Fields("請求先").Value) = False Then Me.Combo1.AddItem Trim(REC.Fields("請求先").Value)
      REC.MoveNext
    Loop
    Set REC = Nothing
    Me.Combo1.Text = "いいままでの顧客一覧"
  End If
  
  'キャプション
     Me.Caption = "MM伝票 Ver " & App.Major & "." & App.Minor & "." & App.Revision

  '年度の割り出し
  If Val(Mid(Date, 6, 2) & Mid(Date, 9, 2)) < 901 Then
    AAA = Val(Mid(Date, 1, 4)) - 1
  Else
    AAA = Val(Mid(Date, 1, 4))
  End If
    
    LNG2 = 0
  
  '総売上
  SQL = "select * from 伝票親 where 削除 = 0"
  Set REC = CNN.Execute(SQL)
  If REC.EOF = False Then
    LNG1 = 0
    Do Until REC.EOF
    BBB = REC.Fields("発行日").Value
      If nendo(AAA, BBB) = True Then    '年度判定
        LNG1 = LNG1 + Val(REC.Fields("合計").Value)
          '経費計算開始////////////////////
          SQL = "select * from 経費 where 削除 = 0 and NO = " & REC.Fields("NO").Value
          Set REC1 = CNN.Execute(SQL)
          If REC1.EOF = False Then
        '    LNG2 = 0
            Do Until REC1.EOF
              LNG2 = LNG2 + Val(REC1.Fields("金額").Value)
              REC1.MoveNext
            Loop
          End If
          Set REC1 = Nothing
          '経費計算終了////////////////////
      End If
      REC.MoveNext
    Loop
  End If
  Set REC = Nothing
  
  'スタッフ経費計算
  LNG3 = Val(PAY(0)) + Val(PAY(1)) + Val(PAY(2)) + Val(PAY(3)) + Val(PAY(4))
  
  MsgBox "【" & AAA & "年度】" & vbCrLf & _
         "売上累計は " & Format(LNG1, "###,###,###") & "円です。" & vbCrLf & _
         "経費累計は " & Format(LNG2, "###,###,###") & "円です。" & vbCrLf & _
         "粗利益は " & Format((LNG1 - LNG2), "###,###,###") & "円です。" & vbCrLf & _
         "スタッフ経費(年間)は " & Format((LNG3), "###,###,###") & "円です。"
  '粗利益-スタッフ経費
  If (LNG1 - LNG2) >= LNG3 Then
    MsgBox "黒字; " & Format((LNG1 - LNG2 - LNG3), "###,###,###") & "円"
  Else
    MsgBox "黒字まであと; " & Format((LNG3 - LNG1 + LNG2), "###,###,###") & "円"
  End If
End Sub

'/////////////////////////////////////////////////
'親・検索
'/////////////////////////////////////////////////
Private Sub lbl_DblClick(Index As Integer)
  If Index = 0 Or Index = 11 Then Exit Sub
'空白CHK
  If IsNull(Trim(Me.txt(Index).Text)) = True Or Len(Trim(Me.txt(Index).Text)) = 0 Then
    MsgBox "検索文字が入力されていません。"
    Exit Sub
  End If

'テキストボックスによってSQL文を『曖昧検索』か『確定検索』か変化させる。
  If Index = 0 Or Index = 3 Or Index = 4 Or Index = 5 Then
    SQL = "select * from 伝票親 where " & Trim(Me.lbl(Index).Caption) & " = '" & Trim(Me.txt(Index).Text) & "'"
  Else
    SQL = "select * from 伝票親 where " & Trim(Me.lbl(Index).Caption) & " like '%" & Trim(Me.txt(Index).Text) & "%'"
  End If
 
  Me.Adodc1.RecordSource = SQL
  Me.Adodc1.Refresh
  
  Set REC = CNN.Execute(SQL)
  If REC.EOF = False Then
    '該当件数の表示
    Me.Adodc1.RecordSource = SQL
    Me.Adodc1.Refresh
    Me.Lbl_CNT.Caption = Me.Adodc1.Recordset.RecordCount
    For CNT = 0 To 10
      If IsNull(REC.Fields(CNT).Value) = False Then
        txt(CNT).Text = REC.Fields(CNT).Value
      End If
    Next CNT
  Else
    MsgBox "該当データがありません。"
    Set REC = Nothing
    Me.Lbl_CNT.Caption = "該当件数0"
    Exit Sub
  End If
  Me.Chk削除(11).Value = REC.Fields(11).Value
  Set REC = Nothing
  
  Call データグリッド更新(Trim(Me.txt(0).Text))
End Sub

'/////////////////////////////////////////////////
'売上データグリッドの更新
'/////////////////////////////////////////////////
Private Function データグリッド更新(NO_NO)
  '売上
  SQL = "select * from 伝票子 where NO = " & NO_NO
  Set REC = CNN.Execute(SQL)
  Me.Adodc2.RecordSource = SQL
  Me.Adodc2.Refresh
  Set REC = Nothing
  Call DG_Width
  '経費
  SQL = "select * from 経費 where NO = " & NO_NO
  Set REC = CNN.Execute(SQL)
  Me.Adodc3.RecordSource = SQL
  Me.Adodc3.Refresh
  Set REC = Nothing
  Call DG2_Width
End Function

'/////////////////////////////////////////////////
'データグリッドの幅
'/////////////////////////////////////////////////
Private Function DG_Width()
  Me.DataGrid1.Columns.Item(0).Width = 500
  Me.DataGrid1.Columns.Item(1).Width = 500
  Me.DataGrid1.Columns.Item(2).Width = 2300
  Me.DataGrid1.Columns.Item(3).Width = 1000
  Me.DataGrid1.Columns.Item(4).Width = 1000
  Me.DataGrid1.Columns.Item(5).Width = 1000
  Me.DataGrid1.Columns.Item(6).Width = 1000
  Me.DataGrid1.Columns.Item(7).Width = 500
  Me.DataGrid1.Columns.Item(8).Width = 500
End Function

'/////////////////////////////////////////////////
'データグリッドの幅
'/////////////////////////////////////////////////
Private Function DG2_Width()
  Me.DataGrid2.Columns.Item(0).Width = 500
  Me.DataGrid2.Columns.Item(1).Width = 500
  Me.DataGrid2.Columns.Item(2).Width = 2300
  Me.DataGrid2.Columns.Item(3).Width = 1000
  Me.DataGrid2.Columns.Item(4).Width = 1000
  Me.DataGrid2.Columns.Item(5).Width = 1000
'  Me.DataGrid2.Columns.Item(6).Width = 1000
'  Me.DataGrid2.Columns.Item(7).Width = 500
'  Me.DataGrid2.Columns.Item(8).Width = 500
End Function

'/////////////////////////////////////////////////
'子・txtのLostForcus
'/////////////////////////////////////////////////
Private Sub txtko_LostFocus(Index As Integer)
If (Index = 3 Or Index = 4) And Len(Trim(Me.txtko(3).Text)) <> 0 And Len(Trim(Me.txtko(4).Text)) <> 0 Then
  Me.txtko(5).Text = Trim(Me.txtko(3).Text) * Trim(Me.txtko(4).Text)
End If
End Sub