querypaybonuse.frm

现金系统： 有直销奖金发放等功能

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form queryPayBonuse 
   Caption         =   "queryPaybonus"
   ClientHeight    =   8955
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   13515
   LinkTopic       =   "Form1"
   ScaleHeight     =   8955
   ScaleWidth      =   13515
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton payandsave 
      Caption         =   "pay and save"
      Height          =   375
      Left            =   9360
      TabIndex        =   12
      Top             =   1080
      Width           =   1695
   End
   Begin VB.CommandButton search 
      Caption         =   "search"
      Height          =   375
      Left            =   4800
      TabIndex        =   11
      Top             =   1200
      Width           =   975
   End
   Begin VB.ComboBox dtdate 
      Enabled         =   0   'False
      Height          =   300
      Left            =   9720
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   240
      Width           =   1575
   End
   Begin VB.ComboBox Cashtype 
      Height          =   300
      Left            =   9840
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton Dele 
      Caption         =   "Delete From"
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   840
      Width           =   855
   End
   Begin VB.CommandButton addId 
      Caption         =   "Add To"
      Height          =   375
      Left            =   3600
      TabIndex        =   5
      Top             =   240
      Width           =   855
   End
   Begin VB.CheckBox paymark 
      Caption         =   "Not Paid"
      Height          =   180
      Left            =   3600
      TabIndex        =   4
      Top             =   1320
      Value           =   1  'Checked
      Width           =   1335
   End
   Begin MSFlexGridLib.MSFlexGrid MSFg 
      Height          =   7095
      Left            =   120
      TabIndex        =   3
      Top             =   1680
      Width           =   13335
      _ExtentX        =   23521
      _ExtentY        =   12515
      _Version        =   393216
      Rows            =   1
      SelectionMode   =   1
   End
   Begin VB.ListBox listId 
      Height          =   780
      Left            =   1800
      TabIndex        =   2
      Top             =   720
      Width           =   1695
   End
   Begin VB.ComboBox distributorID 
      Height          =   300
      Left            =   1920
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label3 
      Caption         =   "Date"
      Height          =   255
      Left            =   9000
      TabIndex        =   10
      Top             =   240
      Width           =   615
   End
   Begin VB.Label Label2 
      Caption         =   "CashType"
      Height          =   255
      Left            =   8880
      TabIndex        =   9
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "distributorID"
      Height          =   255
      Left            =   600
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
End
Attribute VB_Name = "queryPayBonuse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub addId_Click()
    If distributorID.ListIndex <> -1 Then
       For i = listId.ListCount To 0 Step -1
            listId.ListIndex = i - 1
            If listId.Text = distributorID.Text Then
                MsgBox "exist "
                Exit Sub
            End If
       Next i
       listId.AddItem distributorID.Text
    End If
   Call search_Click
End Sub

Private Sub Dele_Click()
If listId.ListCount > 0 And listId.ListIndex <> -1 Then
  listId.RemoveItem listId.ListIndex
    End If
   
End Sub

Private Sub Form_Load()
MSFg.FormatString = "id|IDNumber|  Distributorname      |      Bonus       |   Month     | Mark     |   Symbol   | Singnture   | Singndate "

Dim db As DAO.Database
Dim rs As Recordset
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb") ', False , False , " ; pwd=1234")
Set rs = db.OpenRecordset("SELECT DISTINCT IDNumber FROM bonuslist")
Do While Not rs.EOF
    Me.distributorID.AddItem rs("IDNumber")
    rs.MoveNext
Loop
If distributorID.ListCount > 0 Then
distributorID.ListIndex = 0
End If
ddt = Date
For i = -1000 To 2
  mm = ddt + i
  strdate = Format(mm, "yyyy-MM-dd")
dtdate.AddItem strdate
Next i
dtdate.ListIndex = 1000
Set rs = db.OpenRecordset("SELECT str(CASHTYPE) +'|'+ CASHNAME as TypeName From Cashtype ORDER BY CASHTYPE")
Do While Not rs.EOF
    Cashtype.AddItem rs("TypeName")
    rs.MoveNext
Loop
If Cashtype.ListCount > 0 Then
 Cashtype.ListIndex = 0
 End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

End Sub

Private Sub MSFg_Click()
If paymark.Value = 1 Then
If MSFg.Row <> 1 Then
 yearmonthMark = IIf(Day(Date) > 25, IIf(DatePart("m", Date) + 1 > 12, Trim(Year(Date) + 1), Trim(Year(Date))), Trim(Year(Date))) + Right("0" + Trim(IIf(Day(Date) > 25, IIf(DatePart("m", Date) + 1 > 12, 1, DatePart("m", Date) + 1), DatePart("m", Date))), 2) + "-1"
       markdate = Trim(Year(Date)) + "-" + Right("0" + Trim(DatePart("m", Date)), 2) + "-" + Right("0" + Day(Date), 2)
If Trim(MSFg.TextMatrix(MSFg.Row, 5)) = "" Then
    MSFg.TextMatrix(MSFg.Row, 5) = yearmonthMark
    MSFg.TextMatrix(MSFg.Row, 8) = markdate
Else
     MSFg.TextMatrix(MSFg.Row, 5) = ""
     MSFg.TextMatrix(MSFg.Row, 8) = ""
End If
End If
End If
End Sub

Private Sub payandsave_Click()
On Error GoTo Err_payandsave_Click
Dim db As DAO.Database
Dim rsbonuslist As DAO.Recordset
Dim rs As DAO.Recordset
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb") ', False , False , " ; pwd=1234")
 Dim dateo
    dateo = dtdate.Text
Dim strinfo
Dim mamount
mamount = 0

For i = 1 To MSFg.Rows - 1
    If Trim(MSFg.TextMatrix(i, 5)) <> "" Then
        strinfo = strinfo + "no:" + Trim(MSFg.TextMatrix(i, 2)) + "YearMonth:" + Trim(MSFg.TextMatrix(i, 4)) + "amount:" + Trim(MSFg.TextMatrix(i, 3)) + "~"
        mamount = mamount + Val(Trim(MSFg.TextMatrix(i, 3)))
        Set rsbonuslist = db.OpenRecordset("select * from bonuslist where id=" + MSFg.TextMatrix(i, 0))
        'MsgBox rsbonuslist.RecordCount
        With rsbonuslist
            .Edit
            .Fields("mark") = Trim(MSFg.TextMatrix(i, 5))
            .Fields("singndate") = dateo
            .Update
        End With
        rsbonuslist.Close
    End If

Next


If Len(strinfo) <> 0 Then

    Set rs = db.OpenRecordset("SELECT top 1 operdate, idcash  FROM CASH where brief<>'initial' ORDER BY ID DESC")
    Dim idcash
    If rs.EOF = True Then
        idcash = 1
    Else
        Dim ttOperdate
        ttOperdate = rs("operdate")
        If Int(Mid(ttOperdate, 6, 2)) <> Int(Mid(dtdate.Text, 6, 2)) Then
          idcash = 1
        Else
        idcash = rs("idcash") + 1
         End If
     End If
      ttct = Left(Cashtype.Text, InStr(Cashtype.Text, "|") - 1)
  
    Set rs = db.OpenRecordset("SELECT top 1  REMAINAMOUNT FROM CASH where cashtype=" + ttct + " ORDER BY ID DESC")
    Dim oldvalue
    oldvalue = rs("remainamount") - mamount
     db.Execute " insert into cash (operdate,opertype,person,brief,cashtype,amount,remainamount,operator,idcash)  values ('" + dateo + "',1,'bonuscash','" + strinfo + "'," + Trim(ttct) + "," + Trim(mamount) + "," + Trim(oldvalue) + ",' '," + Trim(idcash) + ")"
    MsgBox "saved,note's no:" + Trim(idcash)
    rs.Close
    MsgBox "pls pay the " + vbCrLf + "amount :" + Format(Str(mamount), "#,###.00"), , "info"
Else
    MsgBox "you should mark which you want to pay", , "info"
End If
listId.Clear
MSFg.Clear
MSFg.FormatString = "id|IDNumber|  Distributorname      |      Bonus       |   Month     | Mark     |   Symbol   | Singnture   | Singndate "

MSFg.Rows = 1
db.Close
Set db = Nothing

Exit_payandsave_Click:
    Exit Sub

Err_payandsave_Click:
    MsgBox Err.Description
    Resume Exit_payandsave_Click
End Sub

Private Sub search_Click()
   ' SELECT a.IDNumber, a.Distributorname, a.BonuseInFCFA, a.Month, a.Mark, a.Symbol, a.Singnture, a.Singndate FROM bonuslist AS a
   Dim strsql
   MSFg.Clear
   Dim db As DAO.Database
Dim rs As Recordset
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb") ', False , False , " ; pwd=1234")
MSFg.FormatString = "id|IDNumber|  Distributorname      |      Bonus       |   Month     | Mark     |   Symbol   | Singnture   | Singndate "
MSFg.Rows = 1
For i = 0 To listId.ListCount - 1
  listId.SetFocus
  listId.ListIndex = i
     strsql = " select id,IDnumber,distributorname,bonuseInFcfa,month,mark,symbol,Singnture,Singndate from bonuslist"
   strsql = strsql + " where idnumber='" + listId.Text + "'"
 
   If IsNull(paymark.Value) Or paymark.Value = 0 Then
    strsql = strsql + " and mark <>'' "
     payandsave.Enabled = False
    Else
    payandsave.Enabled = True
      strsql = strsql + " and mark='' "
    End If
    Set rs = db.OpenRecordset(strsql)
     If Not rs.EOF Then
    rs.MoveLast
    rs.MoveFirst
    MSFg.Cols = 9
    Call fillgrid(rs)
    End If
Next
  


rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub fillgrid(rs As DAO.Recordset)
    For i = 0 To rs.RecordCount - 1
        MSFg.Rows = MSFg.Rows + 1
        For j = 0 To rs.Fields.count - 1
            If j = 3 Then
                MSFg.TextMatrix(MSFg.Rows - 1, j) = Format(Trim(rs(j)), "#,###.00")
            Else
                MSFg.TextMatrix(MSFg.Rows - 1, j) = IIf(IsNull(rs(j)), "", Trim(rs(j)))
            End If
        Next
        rs.MoveNext
    Next
End Sub