bonusch.frm

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

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form bonusch 
   Caption         =   "bonuschan"
   ClientHeight    =   8655
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   14130
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8655
   ScaleWidth      =   14130
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton suma 
      Caption         =   "sum"
      Height          =   375
      Left            =   9840
      TabIndex        =   13
      Top             =   240
      Width           =   615
   End
   Begin VB.TextBox Tamount 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   10680
      Locked          =   -1  'True
      TabIndex        =   12
      Top             =   480
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "export to Excel"
      Height          =   615
      Left            =   12480
      TabIndex        =   10
      Top             =   120
      Width           =   1455
   End
   Begin VB.CommandButton exExcel 
      Caption         =   "export to Excel"
      Height          =   615
      Left            =   5400
      TabIndex        =   9
      Top             =   240
      Width           =   1455
   End
   Begin VB.ComboBox dtaa 
      Height          =   300
      Left            =   8400
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   120
      Width           =   1335
   End
   Begin VB.ComboBox dtbb 
      Height          =   300
      Left            =   8400
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   480
      Width           =   1335
   End
   Begin VB.ComboBox dtdate1 
      Height          =   300
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   480
      Width           =   1575
   End
   Begin VB.ComboBox dtdate 
      Height          =   300
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   120
      Width           =   1575
   End
   Begin MSFlexGridLib.MSFlexGrid MSFg 
      Height          =   7575
      Left            =   120
      TabIndex        =   2
      Top             =   960
      Width           =   13935
      _ExtentX        =   24580
      _ExtentY        =   13361
      _Version        =   393216
      SelectionMode   =   1
   End
   Begin VB.ComboBox mark 
      Height          =   300
      ItemData        =   "bonusch.frx":0000
      Left            =   3480
      List            =   "bonusch.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   360
      Width           =   1455
   End
   Begin VB.Label Label4 
      Caption         =   "Total amount"
      Height          =   255
      Left            =   10680
      TabIndex        =   11
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label3 
      Caption         =   "paid date between"
      Height          =   375
      Left            =   7440
      TabIndex        =   6
      Top             =   240
      Width           =   1095
   End
   Begin VB.Line Line1 
      X1              =   7320
      X2              =   7320
      Y1              =   0
      Y2              =   960
   End
   Begin VB.Label Label2 
      Caption         =   "bonus between"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "Mark:"
      Height          =   255
      Left            =   2880
      TabIndex        =   0
      Top             =   360
      Width           =   735
   End
End
Attribute VB_Name = "bonusch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo Err_exportbonus_Click

Dim db As DAO.Database
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Dim rs As Recordset
strsql = " select IDnumber,distributorname,bonuseInFcfa,month,mark,symbol,Singnture,Singndate from bonuslist "
strsql = strsql + " where  Singndate>='" + dtaa.Text + "' and Singndate<='" + dtbb.Text + "' "

 
Set rs = db.OpenRecordset(strsql)

Call exptoexcel(rs)
MsgBox "export success", vbInformation, "info"

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Exit_exportbonus_Click:
    Exit Sub

Err_exportbonus_Click:
    MsgBox Err.Description
    Resume Exit_exportbonus_Click
End Sub

Private Sub exExcel_Click()
On Error GoTo Err_exportbonus_Click

Dim db As DAO.Database
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Dim rs As Recordset
strsql = " select IDnumber,distributorname,bonuseInFcfa,month,mark,symbol,Singnture,Singndate from bonuslist "
strsql = strsql + " where  month>='" + dtdate.Text + "' and month<='" + dtdate1.Text + "' "
   If mark.Text = "paid" Then
   strsql = strsql + " and  mark <>'' "
     
  End If
  If mark.Text = "not paid" Then
     strsql = strsql + " and   mark =''"
    End If
 
Set rs = db.OpenRecordset(strsql)

Call exptoexcel(rs)
MsgBox "export success", vbInformation, "info"

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Exit_exportbonus_Click:
    Exit Sub

Err_exportbonus_Click:
    MsgBox Err.Description
    Resume Exit_exportbonus_Click
End Sub

Private Sub Form_Load()
mark.AddItem "all"
mark.AddItem "paid"
mark.AddItem "not paid"
ddt = Date
For i = -1000 To 2
  mm = ddt + i
  strdate = Format(mm, "yyyy-MM-dd")
dtdate.AddItem strdate
dtdate1.AddItem strdate
dtaa.AddItem strdate
dtbb.AddItem strdate
Next i
dtdate.ListIndex = 1000
dtdate1.ListIndex = 1000
dtaa.ListIndex = 1000
dtbb.ListIndex = 1000
MSFg.FormatString = "id|IDNumber|  Distributorname      |      Bonus       |   Month     | Mark     |   Symbol   | Singnture   | Singndate "

End Sub

Private Sub mark_Click()
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
strsql = " select id,IDnumber,distributorname,bonuseInFcfa,month,mark,symbol,Singnture,Singndate from bonuslist "
strsql = strsql + " where  month>='" + dtdate.Text + "' and month<='" + dtdate1.Text + "' "
   If mark.Text = "paid" Then
   strsql = strsql + " and  mark <>'' "
     
  End If
  If mark.Text = "not paid" Then
     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
 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
Private Sub exptoexcel(rs As DAO.Recordset)

On Error Resume Next
Dim irow, icol, count As Integer
Dim irowcount, icolcount As Integer
Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

irowcount = rs.RecordCount
icolcount = rs.Fields.count
count = 0
rs.MoveFirst
For icol = 0 To icolcount - 1
xlSheet.cells(1, icol).Value = rs.Fields(icol).Name  '加标头；
Next icol
irow = 2
waita.Text = "pls wait a moment"
Do While Not rs.EOF
    For icol = 0 To icolcount - 1
       ' DoEvents
        xlSheet.cells(irow, icol).Value = rs.Fields(icol) '加标头；
    Next icol
    If irow Mod 200 = 0 Then
    waita.Text = waita.Text + " ."
    End If
    irow = irow + 1
    rs.MoveNext
Loop
xlApp.Visible = True
xlApp.save
xlApp.quit
waita.Text = ""
Set xlApp = Nothing
End Sub

Private Sub suma_Click()
Dim db As DAO.Database
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Dim rs As Recordset
strsql = " select id, IDnumber,distributorname,bonuseInFcfa,month,mark,symbol,Singnture,Singndate from bonuslist "
strsql = strsql + " where  Singndate>='" + dtaa.Text + "' and Singndate<='" + dtbb.Text + "' "
  
 
Set rs = db.OpenRecordset(strsql)

 Dim aamount
 aamount = 0#
 Do While Not rs.EOF
 aamount = aamount + rs("bonuseInFcfa")
 rs.MoveNext
 Loop
 MSFg.Rows = 1
 If rs.RecordCount > 0 Then
    rs.MoveLast
    rs.MoveFirst
    MSFg.Cols = 9
    Call fillgrid(rs)
    End If
Tamount.Text = Format(aamount, "#,###.00")
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub