jmpa_inputdata.frm

一个vb做的工资管理系统

Text1.Text = rs_paset.Fields!fyear
Text2.Text = rs_paset.Fields!fperiod
rs_paset.Close
fpa_setconn.Close

'*************************************************

Call floadstar
Call finputmonthdata   '导入本月数据
End Sub

Sub finputmonthdata()
'导入本月工资数据
Dim fempa As Integer '共有多少行
Dim fitema As Integer '共有多少列
Set conn_selPadataa = CreateObject("adodb.connection")
conn_selPadataa.Open connstring
'Set rs_paemp_sel = conn_selPadata.Execute("select * from Pa_emp where Femplosed='否'") '选择职员表
'If Text2.Text <> 1 Then
 Set rs_padata_sela = conn_selPadataa.Execute("select * from Pa_data where Fyear=" & "'" & Trim(Text1.Text) & "'" & " and Fperiod=" & "'" & Val(Trim(Text2.Text)) & "'")
'Else
' Set rs_padata_sela = conn_selPadata.Execute("select * from Pa_data where Fyear=" & "'" & Val(Trim(Text1.Text)) - 1 & "'" & " and Fperiod=12")
'End If
'Do While rs_paemp_sel.EOF <> True
 Do While rs_padata_sela.EOF <> True
   For fempa = 1 To Me.Cell1.GetRows(0) - 1
    If rs_padata_sela.Fields!fempid = Me.Cell1.GetCellString(1, fempa, 0) Then ' & "-" & Me.Cell1.GetCellString(2, fempa, 0) Then
     For fitema = 3 To Me.Cell1.GetCols(0) - 1
       If rs_padata_sela.Fields!fitemid = Left(Me.Cell1.GetCellString(fitema, 0, 0), InStr(Me.Cell1.GetCellString(fitema, 0, 0), "-") - 1) Then
        Me.Cell1.SetCellString fitema, fempa, 0, rs_padata_sela.Fields!Fdata
       End If
     Next fitema
    End If
   Next fempa
   rs_padata_sela.MoveNext
 Loop
' rs_paemp_sel.MoveNext
'Loop
rs_padata_sela.Close
conn_selPadataa.Close
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
       Case 2
        '保存
        Call fsavedata
       Case 3
        '引出
       Case 4
        '复制本月数据
   Call finputmonthdata   '导入本月工资数据
       Case 5
        '打印
        Cell1.Login "whjminf", "whjminf", "fadfa"
        Cell1.PrintPreview 1, 0
       Case 7
        '工资计算
   Me.Cell1.SetCellString 5, 1, 0, "= c2 + d2"
         Call gzjs   '调工资计算过程
       Case 9
        '调计算器
         ShellExecute 0, "", "calc.exe", "", "", 5

       Case 10
        '导入上期工资数据
        If MsgBox("您是否要导入上个月的工资数据,导入上月工资数据将覆盖当前录入的所有数据!", vbYesNo + vbQuestion, "提示") = vbYes Then
          Call fload_padata_up
        End If
       Case 12
        '关闭
        If MsgBox("请在关闭前将工资数据保存，你是否要退出？", vbYesNo + vbQuestion, "提示") = vbYes Then
          Unload Me
        End If
End Select
       
End Sub
Sub gzjs()
'工资计算
Dim numrowa As Integer  '定义行变量
MsgBox Me.Cell1.GetRows(0)
MsgBox Val(Me.Cell1.GetCellString(3, 1, 0))
MsgBox Val(Me.Cell1.GetCellString(4, 1, 0))
MsgBox Val(Me.Cell1.GetCellString(3, 1, 0)) * Val(Me.Cell1.GetCellString(4, 1, 0))
Me.Cell1.SetCellString 5, 1, 0, Val(Me.Cell1.GetCellString(3, 1, 0)) * Val(Me.Cell1.GetCellString(4, 1, 0))


For numrowa = 1 To Me.Cell1.GetRows(0) ' - 1
 Me.Cell1.SetCellString 5, numrowa, 0, Round(Val(Me.Cell1.GetCellString(3, numrowa, 0)) * Val(Me.Cell1.GetCellString(4, numrowa, 0)), 0)
 Me.Cell1.SetCellString 8, numrowa, 0, Round(Val(Me.Cell1.GetCellString(5, numrowa, 0)) + Val(Me.Cell1.GetCellString(6, numrowa, 0)) - Val(Me.Cell1.GetCellString(7, numrowa, 0)), 0)
 
Next numrowa

End Sub
Sub fsavedata()
'保存工资数据过程
Dim fcellrows As Integer
Dim fsavepadata_sql As String
Set fsave_padataconn = CreateObject("adodb.connection")
fsave_padataconn.Open connstring
Dim fi As Integer, frowsi As Integer
frowsi = 1
fcellrows = Me.Cell1.GetRows(0)
Dim w As Integer

Dim k As Integer
Set rs_del_fperiod = fsave_padataconn.Execute("DELETE * FROM Pa_data where fyear=" & "'" & Trim(Text1.Text) & "'" & " and fperiod=" & "'" & Trim(Text2.Text) & "'")
fsavepadata_sql = "insert into Pa_data(fyear,fperiod,fempid,fitemid,fdata) values (" & "'" & Trim(Text1.Text) & "'" & "," & "'" & Trim(Text2.Text) & "'"
'MsgBox fsavepadata_sql & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & Me.Cell1.GetCellString(2, frowsi, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, 0, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'"
For frowsi = 1 To fcellrows - 1
  
  For k = 3 To Cell1.GetCols(0) - 1
   ' MsgBox fsavepadata_sql & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & Me.Cell1.GetCellString(2, frowsi, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, 0, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'" & ")"
  If Trim(Me.Cell1.GetCellString(k, frowsi, 0)) <> "" Then
    'Set rs_savepadata = fsave_padataconn.Execute(fsavepadata_sql & "," & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & "-" & Me.Cell1.GetCellString(2, frowsi, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, 0, 0) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'" & ")")
    '********************************************************************************************************************Right(rs_load_pa.Fields!fempid, Len(rs_load_pa.Fields!fempid) - InStr(rs_load_pa.Fields!fempid, "-")
    '保存数据
    w = InStr(Me.Cell1.GetCellString(k, 0, 0), "-") - 1 '测试“-”是在哪一位
 '   MsgBox w
 '   MsgBox "总长度=" & Len(Me.Cell1.GetCellString(k, 0, 0))
 '   MsgBox (fsavepadata_sql & "," & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & "'" & "," & "'" & Left(Me.Cell1.GetCellString(k, 0, 0), w) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'" & ")")
    Set rs_savepadata = fsave_padataconn.Execute(fsavepadata_sql & "," & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & "'" & "," & "'" & Left(Me.Cell1.GetCellString(k, 0, 0), w) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'" & ")")
  'MsgBox (fsavepadata_sql & "," & "'" & Me.Cell1.GetCellString(1, frowsi, 0) & "'" & "," & "'" & Left(Me.Cell1.GetCellString(k, 0, 0), Len(Me.Cell1.GetCellString(k, 0, 0)) - InStr(Me.Cell1.GetCellString(k, 0, 0), "-") - 1) & "'" & "," & "'" & Me.Cell1.GetCellString(k, frowsi, 0) & "'" & ")")
  'End
  Else
    MsgBox "单元格：(" & k & "," & frowsi & ")" & "为空，请填写数据或填写数值'0'", vbQuestion + vbOKOnly, "错误"
    Exit Sub
  End If
  Next k

Next frowsi
MsgBox "数据保存成功！", vbOKOnly + vbInformation, "成功"

fsave_padataconn.Close
End Sub
Sub fload_padata_up() '导入上期工资数据
Dim femp As Integer '共有多少行
Dim fitem As Integer '共有多少列
Set conn_selPadata = CreateObject("adodb.connection")
conn_selPadata.Open connstring
'Set rs_paemp_sel = conn_selPadata.Execute("select * from Pa_emp where Femplosed='否'") '选择职员表
If Text2.Text <> 1 Then
 Set rs_padata_sel = conn_selPadata.Execute("select * from Pa_data where Fyear=" & "'" & Trim(Text1.Text) & "'" & " and Fperiod=" & "'" & Val(Trim(Text2.Text)) - 1 & "'")
Else
 Set rs_padata_sel = conn_selPadata.Execute("select * from Pa_data where Fyear=" & "'" & Val(Trim(Text1.Text)) - 1 & "'" & " and Fperiod=12")
End If
'Do While rs_paemp_sel.EOF <> True
 Do While rs_padata_sel.EOF <> True
   For femp = 1 To Me.Cell1.GetRows(0) - 1
    If rs_padata_sel.Fields!fempid = Me.Cell1.GetCellString(1, femp, 0) Then '& "-" & Me.Cell1.GetCellString(2, femp, 0) Then
     For fitem = 3 To Me.Cell1.GetCols(0) - 1
       If rs_padata_sel.Fields!fitemid = Left(Me.Cell1.GetCellString(fitem, 0, 0), InStr(Me.Cell1.GetCellString(fitem, 0, 0), "-") - 1) Then
        Me.Cell1.SetCellString fitem, femp, 0, rs_padata_sel.Fields!Fdata
       End If
     Next fitem
    End If
   Next femp
   rs_padata_sel.MoveNext
 Loop
' rs_paemp_sel.MoveNext
'Loop
rs_padata_sel.Close
conn_selPadata.Close
End Sub
Sub floadstar()
Dim fitem_i As Integer
Dim femp_i As Integer
fitem_i = 3
femp_i = 1
Set fload_conn = CreateObject("adodb.connection")
fload_conn.Open connstring
Set rs_loaditem = fload_conn.Execute("select * from Pa_item order by Fno")
Set rs_loademp = fload_conn.Execute("select * from Pa_emp where Femplosed='否'")
Cell1.SetCellString 1, 0, 0, "职员代码"
Cell1.SetCellString 2, 0, 0, "职员名称"
Do While rs_loaditem.EOF <> True
 Cell1.SetCellString fitem_i, 0, 0, rs_loaditem.Fields!fitemid & "-" & rs_loaditem.Fields!Fitemname
 fitem_i = fitem_i + 1
 rs_loaditem.MoveNext
Loop

Cell1.SetCols fitem_i, 0   '设置多少列

Do While rs_loademp.EOF <> True
  'cell1.setcell
  Cell1.SetCellString 1, femp_i, 0, rs_loademp.Fields!fempid
  Cell1.SetCellNumType 1, femp_i, 0, 7 '设置当前单元为文本
  Cell1.SetCellInput 1, femp_i, 0, 5 '设置当前单元为只读
  
  Cell1.SetCellString 2, femp_i, 0, rs_loademp.Fields!Fempname
  Cell1.SetCellNumType 2, femp_i, 0, 7
  Cell1.SetCellInput 2, femp_i, 0, 5
  femp_i = femp_i + 1
  rs_loademp.MoveNext
Loop

Cell1.SetRows femp_i, 0   '设置多少行

rs_loaditem.Close
rs_loademp.Close
fload_conn.Close
End Sub