个税计算

Private Sub Command计算_Click()

Dim income As Currency

Dim taxrate As Single

Dim deduct As Currency

If Me.税前收入 <> "" Then

    If IsNumeric(Me.税前收入) = False Then

        MsgBox "请输入数值类型数据"

        Exit Sub

    End If

Else

MsgBox "请输入收入"

Exit Sub

End If

If CCur(Me.税前收入) <= 0 Then

MsgBox "收入必须大于0"

Exit Sub

End If

income = Me.税前收入

Me.税后收入 = ""

Me.所得税 = ""

Dim rs1 As Recordset

Set rs1 = CurrentDb.OpenRecordset("税率表", dbOpenTable)

Do While rs1.EOF = False

If income > rs1!最低金额 And income <= rs1!最高金额.Value Then

    taxrate = rs1!税率

    deduct = rs1!速算扣除数

    Me.所得税 = Round(income * taxrate - deduct, 2)

    Me.税后收入 = Me.税前收入 - Me.所得税

End If

rs1.MoveNext

Loop

End Sub

根据模板生成excel表格

生产表格

Private Sub Command生成表格_Click()

On Error GoTo outputerror

Dim copyfilename As String

copyfilename = "工资单模板.xlsx"    '要复制的源文件（Excel）

'输入文件名

Dim outputname As String

outputname = InputBox("请输入导出的文件名", "导出表", "工资单：" & Me.员工号 & Me.姓名 & Me.年份 & "年" & Me.月份 & "月") '输入要生成的表名-

If outputname = "" Or IsNull(outputname) Then   '为空则不执行程序

Exit Sub

End If

'选择导出的位置（文件夹）

Dim exportpath As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

     If .Show = -1 Then

        exportpath = .SelectedItems(1)

        Else

        Exit Sub

     End If

End With

Dim fs As Object

Set fs = CreateObject("Scripting.FileSystemObject")

    fs.copyfile fs.BuildPath(CurrentProject.Path, copyfilename), exportpath & "\" & outputname & ".xlsx"

'打开创建的表并处理数据

Dim excelopenpathname As String

excelopenpathname = exportpath & "\" & outputname & ".xlsx"     '复制粘贴新Excel文件的路径和名称

'处理打开的表数据

Dim xlapp As Excel.Application

Dim xlwbk As Excel.Workbook

Dim xlwsh As Excel.Worksheet

Set xlapp = New Excel.Application

Dim CreateExcel As Object

Set CreateExcel = xlapp

xlapp.Visible = True

xlapp.ScreenUpdating = False

Set xlwbk = xlapp.Workbooks.Open(excelopenpathname)

xlwbk.Activate

Set xlwsh = xlwbk.Worksheets(1)

With xlwsh

    .Cells(4, "B") = Me.员工号

    .Cells(4, "C") = Me.姓名

    .Cells(4, "D") = Me.工资总额

    .Cells(4, "E") = Me.公积金

    .Cells(4, "F") = Me.养老保险

    .Cells(4, "G") = Me.失业保险

    .Cells(4, "H") = Me.医疗保险

    .Cells(4, "I") = Me.所得税

    .Cells(4, "J") = Me.实发工资

    

End With

xlwbk.Save

xlwbk.Close

xlapp.ScreenUpdating = True

xlapp.Quit

MsgBox "生成完成"

'------------------------------------------

Exit Sub

outputerror:

MsgBox Err.Description

End Sub

记录的查询和筛选讲解

导航

Private Sub Command打开_Click()

DoCmd.OpenForm "单记录绑定窗体查询", acNormal, , "所在部门='" & Me.Text部门 & "'"

End Sub

Private Sub Command打开列表_Click()

DoCmd.OpenForm "员工列表", acNormal, , "所在部门='" & Me.所在部门 & "'"

End Sub

Private Sub Command数据表_Click()

DoCmd.OpenForm "员工数据表", acFormDS, , "所在部门='" & Me.所在部门 & "'"

End Sub

多条件筛选查询

Private Sub Command查询_Click()

DoCmd.OpenQuery "员工条件查询", acViewNormal

End Sub

Private Sub Command查询2_Click()

DoCmd.OpenForm "员工条件查询数据表", acFormDS

End Sub

多条件筛选查询2

Public filter_text As String    '定义为公共变量

Private Sub Command查询_Click()

filter_text = ""

If Me.员工号 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 员工号 like '*" & Me.员工号 & "*'"

    Else

    filter_text = "员工号 like '*" & Me.员工号 & "*'"

    End If

End If

If Me.姓名 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 姓名 like '*" & Me.姓名 & "*'"

    Else

    filter_text = "姓名 like '*" & Me.姓名 & "*'"

    End If

End If

If Me.所在部门 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 所在部门 = '" & Me.所在部门 & "'"

    Else

    filter_text = "所在部门 = '" & Me.所在部门 & "'"

    End If

End If

If Me.工龄 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工龄 >=" & Me.工龄

    Else

    filter_text = "工龄 >=" & Me.工龄

    End If

End If

If Me.出生日期1 <> "" And Me.出生日期2 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    Else

    filter_text = "工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    End If

End If

'------------------------------筛选子窗体

If filter_text <> "" Then

DoCmd.OpenForm "员工列表", acNormal, , filter_text

Else

DoCmd.OpenForm "员工列表", acNormal

End If

End Sub

列表框筛选

Private Sub Command部门_Click()

Me.员工查询列表.RowSource = "Select 员工号,姓名,性别,所在部门,职位,工龄 From 员工表 Where 所在部门 like '*" & InputBox("请输入所在部门", "按部门查询") & "*'"

End Sub

Private Sub Command姓名_Click()

Me.员工查询列表.RowSource = "Select 员工号,姓名,性别,所在部门,职位,工龄 From 员工表 Where 姓名 like '*" & InputBox("请输入姓名", "按姓名查询") & "*'"

End Sub

Private Sub Command员工号_Click()

Me.员工查询列表.RowSource = "Select 员工号,姓名,性别,所在部门,职位,工龄 From 员工表 Where 员工号 = '" & InputBox("请输入员工号", "按员工号查询") & "'"

End Sub

Private Sub Command职位_Click()

Me.员工查询列表.RowSource = "Select 员工号,姓名,性别,所在部门,职位,工龄 From 员工表 Where 职位 like '*" & InputBox("请输入现聘职务", "按现聘职务查询") & "*'"

End Sub

员工列表多条件查询

Public filter_text As String    '定义为公共变量

Private Sub Command查询_Click()

filter_text = ""

If Me.员工号查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 员工号 like '*" & Me.员工号查询 & "*'"

    Else

    filter_text = "员工号 like '*" & Me.员工号查询 & "*'"

    End If

End If

If Me.姓名查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 姓名 like '*" & Me.姓名查询 & "*'"

    Else

    filter_text = "姓名 like '*" & Me.姓名查询 & "*'"

    End If

End If

If Me.所在部门查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 所在部门 = '" & Me.所在部门查询 & "'"

    Else

    filter_text = "所在部门 = '" & Me.所在部门查询 & "'"

    End If

End If

If Me.工龄查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工龄 >=" & Me.工龄查询

    Else

    filter_text = "工龄 >=" & Me.工龄查询

    End If

End If

If Me.出生日期1 <> "" And Me.出生日期2 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    Else

    filter_text = "工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    End If

End If

'------------------------------筛选

If filter_text <> "" Then

Me.Filter = filter_text

Me.FilterOn = True

Else

Me.FilterOn = False

End If

End Sub

Private Sub Command全部_Click()

Me.FilterOn = False

End Sub

员工筛选子窗体

Public filter_text As String    '定义为公共变量

Private Sub Command查询_Click()

filter_text = ""

If Me.员工号查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 员工号 like '*" & Me.员工号查询 & "*'"

    Else

    filter_text = "员工号 like '*" & Me.员工号查询 & "*'"

    End If

End If

If Me.姓名查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 姓名 like '*" & Me.姓名查询 & "*'"

    Else

    filter_text = "姓名 like '*" & Me.姓名查询 & "*'"

    End If

End If

If Me.所在部门查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 所在部门 = '" & Me.所在部门查询 & "'"

    Else

    filter_text = "所在部门 = '" & Me.所在部门查询 & "'"

    End If

End If

If Me.工龄查询 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工龄 >=" & Me.工龄查询

    Else

    filter_text = "工龄 >=" & Me.工龄查询

    End If

End If

If Me.出生日期1 <> "" And Me.出生日期2 <> "" Then

    If filter_text <> "" Then

    filter_text = filter_text & " and 工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    Else

    filter_text = "工作时间 between #" & Me.出生日期1 & "# and #" & Me.出生日期2 & "#"

    End If

End If

'------------------------------筛选子窗体

If filter_text <> "" Then

Me.员工数据表.Form.Filter = filter_text

Me.员工数据表.Form.FilterOn = True

Else

Me.员工数据表.Form.FilterOn = False

End If

End Sub

Private Sub Command全部_Click()

Me.员工数据表.Form.FilterOn = False

End Sub