代码调试

Justin-2016

代码调试.zip (46.3 KB, 下载次数: 7)

2024-7-16 08:36 上传

点击文件名下载附件

Sub 新建工资表()
    Dim Conn As Object
    Set Conn = CreateObject("ADODB.Connection")
    Dim StrConn As String, strSQL As String, iYear%, iMonth%, strDate As String, iCount%
    iYear = Application.InputBox(Prompt:="请输入年份", Title:="输入年份", Type:=1)
    iMonth = Application.InputBox(Prompt:="请输入月份", Title:="输入月份", Type:=1)
    If iYear = 0 Or iMonth = 0 Or iMonth > 12 Then
        MsgBox "你的输入有误，请重新输入！"
        Exit Sub
    End If
    Sheets("工资表").Range("A1") = iYear & "年" & iMonth & "月工资表"
    Sheets("工资表").Range("a5:q" & Cells.Rows.Count).ClearContents
    strDate = "#" & DateSerial(iYear, iMonth, 1) & "#"
    StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & "工资管理.accdb;"
    Conn.Open StrConn
    strSQL = "SELECT Count(*) FROM[工资表] WHERE 日期=" & strDate
    iCount = Conn.Execute(strSQL).Fields(0)
    If iCount > 0 Then
        If MsgBox("当前数据库里已存在此记录，是否读取数据库中的记录？", vbYesNo, "提示") = vbYes Then
            strSQL = "SELECT ID,员工编号,姓名,部门,应发合计,基本工资,加班工资," & "补贴,奖金,病事假扣款,养老保险,医疗保险,失业保险,公积金,税前小计," & _
                "个人所得税,实发工资 FROM [工资表] WHERE 日期= " & strDate & "ORDER BY 部门"
            Sheets("工资表").Range("a5").CopyFromRecordset
            Conn.Execute (strSQL)
            Conn.Close
            Exit Sub
        End If
    End If
    strSQL = "SELECT 员工编号,姓名,部门,0 AS 应发合计,基本工资,0 AS 加班工资" & "0 AS 补贴,0 AS 奖金,0 AS 病事假扣款,养老保险,医疗保险,失业保险,公积金,0 AS 税前小计" & _
        "0 AS 个人所得税,0 AS 实发工资,FROM [基础信息] WHERE 在职状态='在职' ORDER BY 部门"
    Sheets("工资表").Range("B5").CopyFromRecordset
    Conn.Execute (strSQL)
    Conn.Close
    With Sheets("工资表")
        iCount = .Range("B" & Cells.Rows.Count).End(xlUp).Row
        .Range("E5:E" & iCount).FormulaR1C1 = "=SUM(RC6:RC9)-RC10"
        .Range("O5:O" & iCount).FormulaR1C1 = "RC5-SUM(RC11:RC14)"
        .Range("P5:P" & iCount).FormulaR1C1 = "ROUND(SUM(TEXT(RC15-{2;2.5;4;7;22;42;62;82;102}*1000,""0;!0"")*5%),2)"
        .Range("Q5:Q" & iCount).FormulaR1C1 = "RC15-RC16"
        .Range("A2") = strDate
    End With
End Sub