📄 form_tongji.frm
字号:
If Check1(5).value = 1 Then
midl = midl + "<td width='45' class='style1'>领料数</td>"
End If
If Check1(6).value = 1 Then
midl = midl + "<td width='60' class='style1'>合格品数</td>"
End If
If Check1(7).value = 1 Then
midl = midl + "<td width='75' class='style1'>不合格品数</td>"
End If
If Check1(8).value = 1 Then
midl = midl + "<td width='45' class='style1'>合格率</td>"
End If
If Check1(9).value = 1 Then
midl = midl + "<td width='66' class='style1'>合格品单价</td>"
End If
If Check1(10).value = 1 Then
midl = midl + "<td width='83' class='style1'>不合格品单价</td>"
End If
If Check1(11).value = 1 Then
midl = midl + "<td width='39' class='style1'>工资</td>"
End If
If Check1(1).value = 1 Then
midl = midl + "<td width='39' class='style1'>支款</td>"
End If
If Check1(12).value = 1 Then
midl = midl + "<td width='62' class='style1'>应发工资</td>"
End If
If Check1(0).value = 1 Then
midl = midl + "<td width='62' class='style1'>备注</td>"
End If
If Check1(13).value = 1 Then
midl = midl + "<td width='62' class='style1'>签名</td>"
End If
midl = midl + "</tr>"
Dim cnt As Integer
Dim slls, shgps, sbhgps, sgz As Double
Dim conn As New ADODB.Connection
Dim conn1 As New ADODB.Connection
Dim conn2 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rsp As New ADODB.Recordset
Dim rsdj As New ADODB.Recordset
Dim hc As Integer
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\database.mdb;Persist Security Info=False"
conn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\database.mdb;Persist Security Info=False"
conn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\database.mdb;Persist Security Info=False"
For I = 1 To zysl
zgz = 0
cnt = 0
If zygz(1, I) = "" Then Exit For
conn.Open
mysql = "select DISTINCT 产品信息.规格型号,名称,工序名,统计表.工序号 from 统计表,职员表,工序表,产品信息 where 统计表.规格型号=产品信息.规格型号 and 统计表.工序号=工序表.工序号 and 统计表.职员号=职员表.职员号 and 统计表.职员号='" & zygz(2, I) & "' "
If Combo2.text <> "" Then
mysql = mysql + " and 名称='" & Combo2.text & "'"
End If
mysql = mysql + " and 日期 Between #" + Str(start.value) + "# and #" + Str(endl.value) + "#"
rs.Open mysql, conn, adOpenStatic, adLockOptimistic
cnt = rs.RecordCount
ReDim gz(7, cnt) As Integer
zgz = 0
For J = 1 To cnt
conn1.Open
midl = midl + "<tr>" + vbCrLf
sumsql1 = "select sum(领料数) as 领料数,sum(合格品数) as 合格品数,sum(不合格品数) as 不合格品数 from 统计表 where 职员号='" & zygz(2, I) & "' and 统计表.规格型号='" & rs("规格型号").value & "'"
rsp.Open sumsql1, conn1, adOpenStatic, adLockOptimistic
If J = 1 Then
If Check1(15).value = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'>" & hc & "</td>"
hc = hc + 1
End If
End If
If J = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'>" & zygz(1, I) & "</td>" + vbCrLf
End If
If J = 1 Then
If Check1(14).value = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'> </td>"
End If
End If
If Check1(2).value = 1 Then
midl = midl + "<td class='style1'>" & rs("工序名") & "</td>" + vbCrLf
End If
If Check1(3).value = 1 Then
midl = midl + "<td class='style1'>" & rs("名称") & "</td>" + vbCrLf
End If
If Check1(4).value = 1 Then
midl = midl + "<td class='style1'>" & rs("规格型号") & "</td>" + vbCrLf
End If
lls = Val(rsp("领料数"))
slls = slls + lls
If Check1(5).value = 1 Then
midl = midl + "<td class='style1'>" & lls & "</td>" + vbCrLf
End If
If Check1(6).value = 1 Then
midl = midl + "<td class='style1'>" & rsp("合格品数") & "</td>" + vbCrLf
End If
hgps = Val(rsp("合格品数"))
shgps = shgps + hgps
If Check1(7).value = 1 Then
midl = midl + "<td class='style1'>" & rsp("不合格品数") & "</td>" + vbCrLf
End If
bhgps = Val(rsp("不合格品数"))
sbhgps = sbhgps + bhgps
hgl = Int(hgps / lls * 100)
If Check1(8).value = 1 Then
midl = midl + "<td class='style1'>" & hgl & "%</td>" + vbCrLf
End If
sqldj = "select * from 单价表 where 规格型号='" & rs("规格型号") & "' and 工序号=" & rs("工序号")
conn2.Open
rsdj.Open sqldj, conn2, adOpenStatic, adLockOptimistic
hgpdj = Val(rsdj("合格品单价"))
If Check1(9).value = 1 Then
midl = midl + "<td class='style1'>" & hgpdj & "</td>" + vbCrLf
End If
kkdj = Val(rsdj("扣款单价"))
If Check1(10).value = 1 Then
midl = midl + "<td class='style1'>" & kkdj & "</td>" + vbCrLf
End If
If hgl >= 95 Or kkdj = 0 Then
gz = Int(hgps * hgpdj * 100) / 100
Else
gz = hgps * hgpdj - (lls * 0.95 - bhgps * kkdj)
End If
zgz = zgz + gz
sgz = sgz + gz
If Check1(11).value = 1 Then
midl = midl + "<td class='style1'>" & gz & "</td>" + vbCrLf
End If
'支款****************************
If Check1(1).value = 1 Then
If J = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'> </td>"
End If
End If
'**************************
If Check1(12).value = 1 Then
If J = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'>xxxp</td>" + vbCrLf
End If
End If
If Check1(0).value = 1 Then
If J = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'> </td>"
End If
End If
If Check1(13).value = 1 Then
If J = 1 Then
midl = midl + "<td rowspan='" & cnt & "' class='style1'> </td>" + vbCrLf
End If
End If
conn1.Close
conn2.Close
midl = midl + "</tr>" + vbCrLf
rs.MoveNext
Next
If Check1(12).value = 1 Then
loc = InStr(midl, "xxxp")
midl = Left(midl, loc - 1) + Str(zgz) + Mid(midl, loc + 4)
End If
rs.Close
conn.Close
Next
Dim startyy, startmm, endlyy, emdlmm, startmonth, endlmonth As String
startyy = Trim(Str(start.Year))
startmm = Trim(Str(start.Month))
If Len(startmm) = 1 Then
startmm = "0" + startmm
End If
startmonth = startyy + "年" + startmm + "月"
endlyy = Trim(Str(endl.Year))
endlmm = Trim(Str(endl.Month))
If Len(endlmm) = 1 Then
endlmm = "0" + endlmm
End If
endlmonth = endlyy + "年" + endlmm + "月"
Adodc5.RecordSource = "SELECT [职员名], [月份], [工资]From 职员表, 其他工资表 WHERE [职员表].[职员号]=[其他工资表].[职员号]" + " and 月份 between '" + startmonth + "' and '" + endlmonth + "'"
Adodc5.Refresh
Dim zym As String
While Not Adodc5.Recordset.EOF
zym = Adodc5.Recordset.Fields("职员名")
gz = Val(Adodc5.Recordset.Fields("工资"))
sgz = sgz + gz
midl = midl + "<tr>"
If Check1(15).value = 1 Then
midl = midl + "<td width='30' class='style1'>" & hc & "</td>"
hc = hc + 1
End If
midl = midl + "<td width='45' class='style1'>" & zym & "</td>"
If Check1(14).value = 1 Then
midl = midl + "<td width='45' class='style1'> </td>"
End If
If Check1(2).value = 1 Then
midl = midl + "<td width='30' class='style1'> </td>"
End If
If Check1(3).value = 1 Then
midl = midl + "<td width='60' class='style1'> </td>"
End If
If Check1(4).value = 1 Then
midl = midl + "<td width='60' class='style1'> </td>"
End If
If Check1(5).value = 1 Then
midl = midl + "<td width='45' class='style1'> </td>"
End If
If Check1(6).value = 1 Then
midl = midl + "<td width='60' class='style1'> </td>"
End If
If Check1(7).value = 1 Then
midl = midl + "<td width='75' class='style1'> </td>"
End If
If Check1(8).value = 1 Then
midl = midl + "<td width='45' class='style1'> </td>"
End If
If Check1(9).value = 1 Then
midl = midl + "<td width='66' class='style1'> </td>"
End If
If Check1(10).value = 1 Then
midl = midl + "<td width='83' class='style1'> </td>"
End If
If Check1(11).value = 1 Then
midl = midl + "<td width='39' class='style1'>" & gz & "</td>"
End If
If Check1(1).value = 1 Then
midl = midl + "<td width='39' class='style1'> </td>"
End If
If Check1(12).value = 1 Then
midl = midl + "<td width='62' class='style1'> </td>"
End If
If Check1(0).value = 1 Then
midl = midl + "<td width='62' class='style1'> </td>"
End If
If Check1(13).value = 1 Then
midl = midl + "<td width='62' class='style1'> </td>"
End If
midl = midl + "</tr>"
Adodc5.Recordset.MoveNext
Wend
If Check_zj.value = 1 Then
midl = midl + "<tr>"
midl = midl + "<td colspan='" & cn & "'>总计:领料数：" & slls & " "
midl = midl + "合格品数：" & shgps & " "
midl = midl + "不合格品数：" & sbhgps & " "
midl = midl + "工资：" & sgz & " "
midl = midl + "</td>"
midl = midl + " </tr>"
End If
midl = midl + "</table>" + vbCrLf
midl = midl + "<p> </p>" + vbCrLf
midl = midl + "</body></html>" + vbCrLf
'midl = midl + "<tr>"
'hgps = zygz(5, i)
'lls = zygz(4, i)
' hgl = Val(hgps) / Val(lls)
' midl = midl + "<td colspan='12'>姓名：" + zygz(1, i) + " 职员号：" + zygz(2, i) + " 工序：" + zygz(3, i) + " 领料数" + lls + " 合格品数：" + hgps + " 合格率：" + Left(Str(hgl * 100), 4) + "%"
'If hgl >= 0.95 Then
' gz = Val(Text1.text) * Val(zygz(5, i))
' Else
' gz = Val(Text1.text) * Val(zygz(5, i)) - (Val(zygz(4, i)) * 0.95 - Val(zygz(5, i))) * Val(Text2.text)
'End If
' midl = midl + " 实发工资：" + Str(gz) + "</td></tr>"
midl = midl + " </table>"
midl = midl + "</body>"
midl = midl + "</html>"
Randomize Time
Path = App.Path + "\" + Str(DateTime.Date) + Str(100 * Rnd) + ".htm"
Open Path For Output As #1
Dim strp As String
strp = top + midl
Print #1, strp
Close #1
Shell ("explorer " + Path)
End Sub
Private Sub Form_Load()
start.value = Date
endl.value = Date
Adodc2.Refresh
gxsl = Adodc2.Recordset.RecordCount
For I = 1 To gxsl
Combo1.AddItem (Adodc2.Recordset.Fields("工序名"))
Adodc2.Recordset.MoveNext
Next
Adodc3.Refresh
While Not Adodc3.Recordset.EOF
Combo2.AddItem (Adodc3.Recordset.Fields("名称"))
Adodc3.Recordset.MoveNext
Wend
Adodc4.Refresh
While Not Adodc4.Recordset.EOF
Combo3.AddItem (Adodc4.Recordset.Fields("职员名"))
Adodc4.Recordset.MoveNext
Wend
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = DanJiaKey(KeyAscii, Text1.text)
End Sub
Private Sub Option1_Click()
For I = 0 To 15
If Check1(I).value = 0 Then Check1(I) = 1
Next
End Sub
Private Sub Option2_Click()
For I = 0 To 15
If Check1(I).value = 1 Then Check1(I) = 0
Next
Check1(12).value = 1
Check1(13).value = 1
End Sub
Private Sub Option3_Click()
For I = 0 To 15
If Check1(I).value = 1 Then Check1(I) = 0
Next
Check1(15).value = 1
Check1(14).value = 1
Check1(11).value = 1
Check1(1).value = 1
Check1(12).value = 1
Check1(0).value = 1
Check1(13).value = 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -