jmpa_find.frm

一个vb做的工资管理系统

VERSION 5.00
Begin VB.Form Form14 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "过滤"
   ClientHeight    =   2265
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   4695
   LinkTopic       =   "Form14"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2265
   ScaleWidth      =   4695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "过滤条件："
      Height          =   2055
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4455
      Begin VB.CommandButton Command2 
         Caption         =   "取  消"
         Height          =   375
         Left            =   2880
         TabIndex        =   6
         Top             =   1320
         Width           =   1095
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确  定"
         Height          =   375
         Left            =   2880
         TabIndex        =   5
         Top             =   600
         Width           =   1095
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         Left            =   1080
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   1320
         Width           =   1455
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   1080
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   600
         Width           =   1455
      End
      Begin VB.Label Label2 
         Caption         =   "月份："
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   1320
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "部门名称："
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   600
         Width           =   975
      End
   End
End
Attribute VB_Name = "Form14"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Call fbmpa_rpt
Unload Me
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Call loadstar   '加载初始值
End Sub

Sub loadstar()
'Combo1.Text = ""
'Combo2.Text = ""
Dim bmnum As Integer
Dim k As Integer
bmnum = 0
Set conn_bm = CreateObject("adodb.connection")
conn_bm.Open connstring
Set rs_bm = conn_bm.Execute("select * from pa_bm")

Do While rs_bm.EOF <> True
  Combo1.AddItem rs_bm.Fields!fbmname, bmnum
  bmnum = bmnum + 1
  rs_bm.MoveNext
Loop

For k = 1 To 12
    Combo2.AddItem k & "月", k - 1
Next k

rs_bm.Close
conn_bm.Close
End Sub

Sub fbmpa_rpt()
Dim bm_rpt_sql As String
Set conn_bm_rpt = CreateObject("adodb.connection")
conn_bm_rpt.Open connstring
'Set rs_pabm_rpt = conn_bm_rpt.Execute("select * from pa_bm " )   '部门
Set rs_paemp_rpt = conn_bm_rpt.Execute("select * from pa_emp where fempbm=" & "'" & Combo1.Text & "'") '职员
Set rs_paitem_rpt = conn_bm_rpt.Execute("select * from pa_item") '工资项目
Set rs_item_num = conn_bm_rpt.Execute("select count(*) as fitemnum from pa_item") '确定有多少工资项目（数量上）

bm_rpt_sql = "SELECT pa_data.fyear as 年,pa_data.fperiod as 月,pa_emp.fempname as 职员名称," _
           & "pa_emp.fempbm as 部门,pa_item.fitemname as 项目,pa_data.fdata as 金额 " _
           & " From pa_data, pa_emp, pa_bm, pa_item " _
           & " Where [pa_data].[fempid] = [pa_emp].[fempid] And [pa_emp].[fempbm] = [pa_bm].[fbmname] " _
           & " And [pa_item].[Fitemid] = [pa_data].[Fitemid] "

With Form10.Cell1
       .SetCols (Val(rs_item_num.Fields!fitemnum) + 3), 0 '设置表格共有多少列
       
End With
rs_item_num.Close
Dim itemi As Integer
itemi = 2
Do While rs_paitem_rpt.EOF <> True
  Form10.Cell1.SetCellString 2, 1, 0, "姓名"
  Form10.Cell1.SetCellString itemi + 1, 1, 0, rs_paitem_rpt.Fields!Fitemname '工资项目
  Form10.Cell1.SetCellString 1, 1, 0, "序号"
 ' Form10.Cell1.SetCellString 1, itemi, 0, itemi - 1
  rs_paitem_rpt.MoveNext
  itemi = itemi + 1
Loop

rs_paitem_rpt.Close
Set rs_set = conn_bm_rpt.Execute("select * from Pa_set")
Dim empi As Integer
empi = 2
'确定该部门中的人名
Do While rs_paemp_rpt.EOF <> True
  Form10.Cell1.SetCellString 2, empi, 0, rs_paemp_rpt.Fields!Fempname  '加载人员名称到表格中
  Form10.Cell1.SetCellString 1, empi, 0, empi - 1   '加载序号到表格中
  empi = empi + 1
  rs_paemp_rpt.MoveNext
Loop
Form10.Cell1.SetRows empi + 1, 0 '设置表格共有多少行
 rs_paemp_rpt.Close

'Set rs_bm_rpt = conn_bm_rpt.Execute(bm_rpt_sql & " and pa_data.fyear=" & "'" & rs_set.Fields!Fyear & "'" & " and pa_data.Fperiod=" & "'" & Left(Me.Combo2.Text, Len(Me.Combo2.Text) - 1) & "'")

If Combo1.Text <> "" Then
 If Combo2.Text <> "" Then
  Form10.Cell1.PrintSetHead "", Form14.Combo1.Text & Form14.Combo2.Text & "工资", ""
  Form10.Cell1.PrintSetHeaderFont Form10.Cell1.FindFontIndex("宋体", 1), 20, 1, RGB(255, 0, 0)
 
 '找工资数据表SQL
  Set rs_bm_rpt = conn_bm_rpt.Execute(bm_rpt_sql & " and pa_data.fyear=" & "'" & rs_set.Fields!fyear & "'" & " and pa_data.Fperiod=" & "'" & Left(Me.Combo2.Text, Len(Me.Combo2.Text) - 1) & "'")
  
  '填数据到表格中
  Do While rs_bm_rpt.EOF <> True
   
   For a = 2 To Form10.Cell1.GetRows(0) - 1
    If rs_bm_rpt.Fields!职员名称 = Form10.Cell1.GetCellString(2, a, 0) Then
     For b = 3 To Form10.Cell1.GetCols(0) - 1
       If rs_bm_rpt.Fields!项目 = Form10.Cell1.GetCellString(b, 1, 0) Then
       '  Form10.Cell1.D b, a, 0, rs_bm_rpt.Fields!金额
          Form10.Cell1.SetCellString b, a, 0, rs_bm_rpt.Fields!金额
       End If
     Next b
    End If
   Next a
  
   Form10.Cell1.DrawGridLine 0, 0, b, a, 0, 2, -1
   rs_bm_rpt.MoveNext
  Loop
  rs_bm_rpt.Close
  Form10.Show , Form1
 Else
  MsgBox "请选择要查询的月份！", vbOKOnly + vbInformation, "提示"
 End If
Else
 MsgBox "请选择部门名称！", vbOKOnly + vbInformation, "提示"
End If
rs_set.Close
conn_bm_rpt.Close
Call ftotal
Call tzcelldata   '调用调整表格中数据
End Sub

'以下为调整表格中数据
Sub tzcelldata()
Dim frows As Integer  '获取原始表格有多少行
Dim fcols As Integer '获取原始表格有多少列
Dim frowsa As Integer '修改后表格的行变量

frows = Form10.Cell1.GetRows(0)  '获得一共有多少行

fcols = Form10.Cell1.GetCols(0)   '获得原始表格有多少列

Form10.Cell1.SetCols fcols * 2, 0  '设置新的表格列数

frowsa = Round(frows / 2, 0)
For h = 1 To fcols
  Form10.Cell1.SetCellString fcols + h, 1, 0, Form10.Cell1.GetCellString(h, 1, 0)
 For k = 1 To frowsa
  Form10.Cell1.SetCellString fcols + h, k + 1, 0, Form10.Cell1.GetCellString(h, frowsa + k, 0)
  Form10.Cell1.SetCellString h, frowsa + k, 0, ""
 Next k
Next h
Form10.Cell1.SetRows frowsa + 1, 0
End Sub

Sub ftotal()  '合计实发金额
Dim a As Integer
Dim totalmoney As Double
totalmoney = 0
For a = 1 To Form10.Cell1.GetRows(0) - 1
  totalmoney = totalmoney + Val(Form10.Cell1.GetCellString(Form10.Cell1.GetCols(0) - 1, a, 0))
Next a
'MsgBox totalmoney
Form10.Cell1.SetCellString 1, Form10.Cell1.GetRows(0) - 1, 0, "合计："
Form10.Cell1.SetCellString Form10.Cell1.GetCols(0) - 1, Form10.Cell1.GetRows(0) - 1, 0, totalmoney
End Sub