?? 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 + -