📄 cpjdtz.frm
字号:
Left = 9000
TabIndex = 8
Top = 900
Width = 1455
End
Begin VB.Label lblbj
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 1
Left = 6780
TabIndex = 7
Top = 900
Width = 1455
End
Begin VB.Label lblcp
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 2
Left = 9000
TabIndex = 6
Top = 540
Width = 1455
End
Begin VB.Label lblcp
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 1
Left = 6780
TabIndex = 5
Top = 540
Width = 1455
End
Begin VB.Label lblbj
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 4740
TabIndex = 4
Top = 900
Width = 1395
End
Begin VB.Label lblcp
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 4740
TabIndex = 3
Top = 540
Width = 1395
End
Begin VB.Label lblsl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Left = 11040
TabIndex = 2
Top = 540
Width = 735
End
Begin VB.Label lblzl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Left = 11040
TabIndex = 1
Top = 900
Width = 735
End
Begin VB.Label Label1
Caption = "工时、吨位完成情况台帐"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Index = 0
Left = 540
TabIndex = 0
Top = 240
Width = 2775
End
End
Attribute VB_Name = "cpjdtz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private TempNode As Node
Dim txtnode As String, txtkey As String, intIndex As Integer
Dim curyear As Integer, curmonth1 As Integer, curmonth2 As Integer
Dim curdate1 As String, curdate2 As String, curgxmc As String '工序名称
Dim Gsdn As Currency, gszp As Currency, gswx As Currency, gsxx As Currency, subtotgs As Currency '工时小计
Dim currow As Integer, currow2 As Integer, CURcol As Integer '列小计时用，取定范围
Private Sub Form_Load()
Me.Width = 12000: Me.Height = 9000
Set rsTempA = oDb.Execute("select * from acp where cpyn='Y' order by cpbh")
Do Until rsTempA.EOF
Set TempNode = TvwDB.Nodes.Add()
TempNode.Text = rsTempA!cpbh & "," & rsTempA!cpmc & "." & rsTempA!cpxh
TempNode.Key = "'" & rsTempA!cpbh & "'"
intIndex = TempNode.Index
txtkey = TempNode.Key
Set rsTempB = oDb.Execute("select * from abj where cpbh=" & txtkey)
Do Until rsTempB.EOF
Set TempNode = TvwDB.Nodes.Add(intIndex, tvwChild)
TempNode.Text = rsTempB!bjbh & "," & rsTempB!bjmc & "." & rsTempB!bjth
rsTempB.MoveNext
Loop
rsTempA.MoveNext
Loop
'TvwDB.Nodes(1).Expanded = True
txtym.Text = Year(NOWDate) & Format(Month(NOWDate), "00")
dogridfirst
txtcpbh.Visible = False
End Sub
Private Sub cmdfind_Click()
If lblbj(0).Caption = "" Then Exit Sub
If Len(Trim(txtym.Text)) <> 6 Then '定义当前月
Exit Sub
End If
If Val(Mid(txtym.Text, 5, 2)) = 1 Then
curyear = Left(txtym.Text, 4) - 1
curmonth1 = 12
curmonth2 = 1
Else
curyear = Left(txtym.Text, 4)
curmonth1 = Mid(txtym.Text, 5, 2) - 1
curmonth2 = Mid(txtym.Text, 5, 2)
End If
curdate1 = curyear & "-" & Format(curmonth1, "00") & "-26"
curdate2 = curyear & "-" & Format(curmonth2, "00") & "-25"
Grid1.Rows = 2
Grid1.Cell(0, 8).Text = ""
Grid1.Cell(0, 11).Text = ""
Grid1.Cell(0, 14).Text = ""
Grid1.Cell(0, 17).Text = ""
Grid1.Cell(0, 20).Text = ""
'填列表格正文，有保存和未保存的
Set rsTempA = oDb.Execute("select * from ajdtzh where bjbh='" & lblbj(0).Caption & "'")
If rsTempA.RecordCount > 0 Then '有数据 先填列原有的，再检索当前月的数据填入相应单元格中，（以工时合计数判定填入何列）
lblstar.Caption = rsTempA!ymstar
Grid1.Cell(0, 5).Text = rsTempA!ymstar
'当前月份列定位
If Val(Mid(txtym.Text, 5, 2)) - Val(Mid(rsTempA!ymcur, 5, 2)) = 0 Then '当前月份相同，只显示原有的，不操作其它
szSql = "select * from ajdtz where bjbh ='" & lblbj(0).Caption & "' order by code"
Set rsTempA = oDb.Execute(szSql)
Do Until rsTempA.EOF
griditem = rsTempA!code & Chr(9) & rsTempA!cjmc & Chr(9) & rsTempA!gxmc & Chr(9) & rsTempA!gxgs & Chr(9) & rsTempA!ymsub1 & Chr(9) & rsTempA!ymwx1 & Chr(9) & rsTempA!ymtot1
griditem = griditem & Chr(9) & rsTempA!ymsub2 & Chr(9) & rsTempA!ymwx2 & Chr(9) & rsTempA!ymtot2 & Chr(9) & rsTempA!ymsub3 & Chr(9) & rsTempA!ymwx3 & Chr(9) & rsTempA!ymtot3 & Chr(9) & rsTempA!ymsub4 & Chr(9) & rsTempA!ymwx4 & Chr(9) & rsTempA!ymtot4
griditem = griditem & Chr(9) & rsTempA!ymsub5 & Chr(9) & rsTempA!ymwx5 & Chr(9) & rsTempA!ymtot5 & Chr(9) & rsTempA!ymsub6 & Chr(9) & rsTempA!ymwx6 & Chr(9) & rsTempA!ymtot6
Grid1.AddItem griditem
rsTempA.MoveNext
Loop
Exit Sub
End If
If Val(Mid(txtym.Text, 5, 2)) - Val(Mid(rsTempA!ymstar, 5, 2)) > 0 Then '同年，月份相减
CURcol = 4 + (Val(Mid(txtym.Text, 5, 2)) - Val(Mid(rsTempA!ymstar, 5, 2))) * 3 + 1 '原4列＋每月3列＋1
End If
If Val(Mid(txtym.Text, 5, 2)) - Val(Mid(rsTempA!ymstar, 5, 2)) < 0 Then '当前月份相同，不操作
CURcol = 4 + (12 + Val(Mid(txtym.Text, 5, 2)) - Val(Mid(rsTempA!ymstar, 5, 2))) * 3 + 1
End If
If CURcol > 20 Then Exit Sub '月份跨度大于6个月退出，列会不足，如需要则添加库字段及列数
szSql = "select * from ajdtz where bjbh ='" & lblbj(0).Caption & "' order by code"
Set rsTempA = oDb.Execute(szSql)
Do Until rsTempA.EOF
griditem = rsTempA!code & Chr(9) & rsTempA!cjmc & Chr(9) & rsTempA!gxmc & Chr(9) & rsTempA!gxgs & Chr(9) & rsTempA!ymsub1 & Chr(9) & rsTempA!ymwx1 & Chr(9) & rsTempA!ymtot1
griditem = griditem & Chr(9) & rsTempA!ymsub2 & Chr(9) & rsTempA!ymwx2 & Chr(9) & rsTempA!ymtot2 & Chr(9) & rsTempA!ymsub3 & Chr(9) & rsTempA!ymwx3 & Chr(9) & rsTempA!ymtot3 & Chr(9) & rsTempA!ymsub4 & Chr(9) & rsTempA!ymwx4 & Chr(9) & rsTempA!ymtot4
griditem = griditem & Chr(9) & rsTempA!ymsub5 & Chr(9) & rsTempA!ymwx5 & Chr(9) & rsTempA!ymtot5 & Chr(9) & rsTempA!ymsub6 & Chr(9) & rsTempA!ymwx6 & Chr(9) & rsTempA!ymtot6
Grid1.AddItem griditem
rsTempA.MoveNext
Loop
'当前月数据检索
For i = 2 To Grid1.Rows - 3
curgxmc = Grid1.Cell(i, 3).Text
szSql = "select sum(gpdnb.gpgs) as sumgs from gpdnh,gpdnb where (gpdnh.gpbh=gpdnb.gpbh) and gpdnh.gprq>='" & curdate1 & "' and gpdnh.gprq<='" & curdate2 & "'" _
& " and gpdnb.gpbjbh='" & lblbj(0).Caption & "' and gpdnb.gpgxmc='" & curgxmc & "'"
Set rsTempB = oDb.Execute(szSql)
If Not IsNull(rsTempB!sumgs) Then Gsdn = rsTempB!sumgs Else Gsdn = 0
'增拨工时 不需要统计进去 2006.10.8改
'szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & curdate1 & "' and gpzph.gprq<='" & curdate2 & "'" _
' & " and gpzpb.gpbjbh='" & lblbj(0).Caption & "' and gpzpb.gpgxmc='" & curgxmc & "'"
'Set rsTempB = oDb.Execute(szSql)
'If Not IsNull(rsTempB!sumgs) Then gszp = rsTempB!sumgs Else gszp = 0
gszp = 0
'外协工时
szSql = "select sum(gpwxb.gpgs) as sumgs from gpwxh,gpwxb where (gpwxh.gpbh=gpwxb.gpbh) and gpwxh.gprq>='" & curdate1 & "' and gpwxh.gprq<='" & curdate2 & "'" _
& " and gpwxb.gpbjbh='" & lblbj(0).Caption & "' and gpwxb.gpgxmc='" & curgxmc & "'"
Set rsTempB = oDb.Execute(szSql)
If Not IsNull(rsTempB!sumgs) Then gswx = rsTempB!sumgs Else gswx = 0
If (Gsdn + gszp) > 0 Then Grid1.Cell(i, CURcol).Text = Round((Gsdn + gszp) / 60, 1)
If gswx > 0 Then Grid1.Cell(i, CURcol + 1).Text = Round(gswx / 60, 1)
If (Gsdn + gszp + gswx) > 0 Then Grid1.Cell(i, CURcol + 2).Text = Round((Gsdn + gszp + gswx) / 60, 1)
Next i
'列小计
Gsdn = 0 '小计车间一
gszp = 0 '小计车间二
gswx = 0
gsxx = 0
For i = 2 To Grid1.Rows - 3
If Val(Grid1.Cell(i, 2).Text) > 0 Then
currow = i
Exit For
End If
Next
For i = 2 To currow - 1
Gsdn = Gsdn + Val(Grid1.Cell(i, CURcol).Text)
gswx = gswx + Val(Grid1.Cell(i, CURcol + 1).Text)
Next i
Grid1.Cell(currow, CURcol).Text = Gsdn '车间小计数
Grid1.Cell(currow, CURcol + 1).Text = gswx '车间外协小计
Grid1.Cell(currow, CURcol + 2).Text = Gsdn + gswx '车间累计
For i = currow + 1 To Grid1.Rows - 3
If Val(Grid1.Cell(i, 2).Text) > 0 Then
currow2 = i
Exit For
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -