📄 cpbjjd.frm
字号:
Top = 1440
Width = 435
End
Begin VB.Label Label1
Caption = "单位编号"
Height = 195
Index = 3
Left = 720
TabIndex = 3
Top = 1440
Width = 795
End
Begin VB.Label Label1
Caption = "部件名称"
Height = 195
Index = 2
Left = 4980
TabIndex = 2
Top = 1020
Width = 735
End
Begin VB.Label Label1
Caption = "产品编号"
Height = 195
Index = 1
Left = 2850
TabIndex = 1
Top = 600
Width = 795
End
Begin VB.Label Label1
Caption = "生 产 进 度 表"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
Index = 0
Left = 4680
TabIndex = 0
Top = 0
Width = 2535
End
End
Attribute VB_Name = "cpbjjd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Me.Width = 12000: Me.Height = 9000
'Grid1.AllowUserResizing = True
Grid1.DisplayFocusRect = False
Grid1.ExtendLastCol = True
dogridfirst '表单样式
dogridfill '表单格式内容
Grid1.AutoRedraw = True
Grid1.Refresh
Grid2.RowHeight(0) = 2
dogridfill2
End Sub
Private Sub cmdsave_Click()
'表格内容保存到表ajdlj,如已有零件编号的更新，没有的增加
If Grid1.Rows = 1 Then Exit Sub
For i = 1 To Grid1.Rows - 1
griditem = Grid1.Cell(i, 2).Text
Set rsTempA = oDb.Execute("select * from ajdlj where ljbh='" & griditem & "'")
If rsTempA.RecordCount < 1 Then '增加保存
'部件编号＋序号＋零件编号＋零件名称＋图号＋数量
griditem = "'" & lblbj(0).Caption & "'," & Grid1.Cell(i, 1).Text & ",'" & Grid1.Cell(i, 2).Text & "','" & Grid1.Cell(i, 3).Text & "','" & Grid1.Cell(i, 4).Text & "'," & Grid1.Cell(i, 5).Text & ","
For j = 6 To Grid1.Cols - 3 Step 2
If Grid1.Cell(i, j).Text = "" Then griditem = griditem & "''," Else griditem = griditem & "'" & Grid1.Cell(i, j).Text & "',"
If Grid1.Cell(i, j + 1).Text = "" Then griditem = griditem & "0," Else griditem = griditem & Grid1.Cell(i, j + 1).Text & ","
Next j
griditem = griditem & "'" & Grid1.Cell(i, Grid1.Cols - 2).Text & "','" & Grid1.Cell(i, Grid1.Cols - 1).Text & "'"
szSql = "insert ajdlj (bjbh,code,ljbh,ljmc,ljth,ljsl,gxmc1,gxgs1,gxmc2,gxgs2,gxmc3,gxgs3,gxmc4,gxgs4,gxmc5,gxgs5,gxmc6,gxgs6,gxmc7,gxgs7,gxmc8,gxgs8,gxmc9,gxgs9,gxmc10,gxgs10,gxmc11,gxgs11,gxmc12,gxgs12,gxmc13,gxgs13,gxmc14,gxgs14,gxmc15,gxgs15,ljqx,ljbz) values (" & griditem & ")"
oDb.Execute szSql
Else
szSql = "UPDATE ajdlj SET gxmc1='" & Grid1.Cell(i, 6).Text & "',gxgs1=" & Grid1.Cell(i, 7).Text & ",gxmc2='" & Grid1.Cell(i, 8).Text & "',gxgs2=" & Grid1.Cell(i, 9).Text & ""
szSql = szSql & ",gxmc3='" & Grid1.Cell(i, 10).Text & "',gxgs3=" & Grid1.Cell(i, 11).Text & ",gxmc4='" & Grid1.Cell(i, 12).Text & "',gxgs4=" & Grid1.Cell(i, 13).Text & ""
szSql = szSql & ",gxmc5='" & Grid1.Cell(i, 14).Text & "',gxgs5=" & Grid1.Cell(i, 15).Text & ",gxmc6='" & Grid1.Cell(i, 16).Text & "',gxgs6=" & Grid1.Cell(i, 17).Text & ""
szSql = szSql & ",gxmc7='" & Grid1.Cell(i, 18).Text & "',gxgs7=" & Grid1.Cell(i, 19).Text & ",gxmc8='" & Grid1.Cell(i, 20).Text & "',gxgs8=" & Grid1.Cell(i, 21).Text & ""
szSql = szSql & ",gxmc9='" & Grid1.Cell(i, 22).Text & "',gxgs9=" & Grid1.Cell(i, 23).Text & ",gxmc10='" & Grid1.Cell(i, 24).Text & "',gxgs10=" & Grid1.Cell(i, 25).Text & ""
szSql = szSql & ",gxmc11='" & Grid1.Cell(i, 26).Text & "',gxgs11=" & Grid1.Cell(i, 27).Text & ",gxmc12='" & Grid1.Cell(i, 28).Text & "',gxgs12=" & Grid1.Cell(i, 29).Text & ""
szSql = szSql & ",gxmc13='" & Grid1.Cell(i, 30).Text & "',gxgs13=" & Grid1.Cell(i, 31).Text & ",gxmc14='" & Grid1.Cell(i, 32).Text & "',gxgs14=" & Grid1.Cell(i, 33).Text & ""
szSql = szSql & ",gxmc15='" & Grid1.Cell(i, 34).Text & "',gxgs15=" & Grid1.Cell(i, 35).Text & ""
szSql = szSql & ",ljbz='" & Grid1.Cell(i, 37).Text & "'"
szSql = szSql & " where ljbh='" & Grid1.Cell(i, 2).Text & "'"
oDb.Execute szSql
End If
Next i
MsgBox "进度表数据已保存完毕！", vbOKOnly, "数据保存"
End Sub
Private Sub cmdtot_Click()
'工序工时数小计
'按需统计的工序名称循环进度表工序名称，如一致工时相加，填入表格二
Dim subtotgs As Currency, totalgs As Currency, CURcol As Integer
Grid2.Cols = 3
CURcol = 2
totalgs = 0
Set rsTempA = oDb.Execute("select * from agx where gxtj='Y' order by gxbh")
Do Until rsTempA.EOF
subtotgs = 0
For i = 1 To Grid1.Rows - 1
For j = 6 To Grid1.Cols - 3 Step 2
If Grid1.Cell(i, j).Text = rsTempA!gxmc Then '工序名称相同
subtotgs = subtotgs + Val(Grid1.Cell(i, j + 1).Text)
End If
Next j
Next i
If subtotgs > 0 Then '有工时数则显示在表格二中
Grid2.Cell(0, CURcol).Text = rsTempA!gxbh
Grid2.Cell(1, CURcol).Text = rsTempA!gxmc
Grid2.Cell(2, CURcol).Text = Round(subtotgs / 60, 1) '工时分钟转为小时
Grid2.Column(CURcol).Width = 40
totalgs = totalgs + Round(subtotgs / 60, 1)
Grid2.Cols = Grid2.Cols + 1
CURcol = CURcol + 1
End If
rsTempA.MoveNext
Loop
Grid2.Cell(1, Grid2.Cols - 1).Text = "总工时(H)"
Grid2.Cell(2, Grid2.Cols - 1).Text = totalgs
End Sub
Private Sub cmdsavetot_Click()
'表格二内容保存到表ajdbj,如已有则更新，没有的增加
If Grid2.Cols < 3 Then Exit Sub
For j = 2 To Grid2.Cols - 2
griditem = Grid2.Cell(0, j).Text
Set rsTempA = oDb.Execute("select * from ajdbj where bjbh='" & lblbj(0).Caption & "' and gxbh='" & griditem & "'")
If rsTempA.RecordCount < 1 Then '增加保存
'产品编号 +部件编号
griditem = "'" & lblcp(0).Caption & "','" & lblbj(0).Caption & "',"
griditem = griditem & "'" & Grid2.Cell(0, j).Text & "','" & Grid2.Cell(1, j).Text & "'," & Grid2.Cell(2, j).Text & ""
szSql = "insert ajdbj (cpbh,bjbh,gxbh,gxmc,gxgs) values (" & griditem & ")"
oDb.Execute szSql
Else
szSql = "UPDATE ajdbj SET gxgs=" & Grid2.Cell(2, j).Text & " where bjbh='" & lblbj(0).Caption & "' and gxbh='" & Grid2.Cell(0, j).Text & "'"
oDb.Execute szSql
End If
Next j
'本部件总工时数保存到abj表中
szSql = "UPDATE abj SET bjtotgs=" & Grid2.Cell(2, Grid2.Cols - 1).Text & " where bjbh='" & lblbj(0).Caption & "'"
oDb.Execute szSql
MsgBox "工时统计数据已保存完毕！", vbOKOnly, "数据保存"
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmddate2_Click()
MonthView2.Visible = True
End Sub
Private Sub MonthView2_DateClick(ByVal DateClicked As Date)
MonthView2.Visible = False
mskdate2.Text = MonthView2.Value
End Sub
Private Sub cmbcp_LostFocus()
'选取产品后，相应部件填入cmbbj下拉框
i = InStr(cmbcp.Text, ",")
j = InStr(cmbcp.Text, ".")
lblcp(0).Caption = Left(cmbcp.Text, i - 1)
lblcp(1).Caption = Mid(cmbcp.Text, i + 1, j - i - 1)
lblcp(2).Caption = Mid(cmbcp.Text, j + 1)
'单位编号、名称
Set rsTempB = oDb.Execute("select * from acp where cpbh='" & Left(cmbcp.Text, i - 1) & "'")
lbldh(0).Caption = rsTempB!dhbh
lbldh(1).Caption = rsTempB!dhmc
cmbbj.Clear
Set rsTempB = oDb.Execute("select * from abj where cpbh='" & Left(cmbcp.Text, i - 1) & "'")
Do Until rsTempB.EOF
cmbbj.AddItem rsTempB!bjbh & "," & rsTempB!bjmc & "." & rsTempB!bjth
rsTempB.MoveNext
Loop
End Sub
Private Sub cmbbj_LostFocus()
'选取部件后，相应零件信息填入进度表表格。
'添加是否有保存的
MousePointer = vbHourglass
i = InStr(cmbbj.Text, ",")
j = InStr(cmbbj.Text, ".")
If i < 1 Then Exit Sub
lblbj(0).Caption = Left(cmbbj.Text, i - 1)
lblbj(1).Caption = Mid(cmbbj.Text, i + 1, j - i - 1)
lblbj(2).Caption = Mid(cmbbj.Text, j + 1)
Set rsTempB = oDb.Execute("select * from abj where bjbh='" & Left(cmbbj.Text, i - 1) & "'")
lblsl.Caption = rsTempB!bjsl
lblzl.Caption = rsTempB!bjzl
Grid1.Rows = 1
'如部件进度表（零件工时表）中没有数据，则填入初始零件信息，如已有，则说明曾有数据，检索显示即可
Set rsTempA = oDb.Execute("select * from ajdlj where bjbh='" & Left(cmbbj.Text, i - 1) & "' order by code")
If rsTempA.RecordCount > 0 Then
'先前有保存的，填充数据
Do Until rsTempA.EOF
griditem = (rsTempA!code - 1) & Chr(9) & rsTempA!ljbh & Chr(9) & Trim(rsTempA!ljmc) & Chr(9) & Trim(rsTempA!ljth) & Chr(9) & rsTempA!ljsl
griditem = griditem & Chr(9) & rsTempA!gxmc1 & Chr(9) & rsTempA!gxgs1 & Chr(9) & rsTempA!gxmc2 & Chr(9) & rsTempA!gxgs2 & Chr(9) & rsTempA!gxmc3 & Chr(9) & rsTempA!gxgs3
griditem = griditem & Chr(9) & rsTempA!gxmc4 & Chr(9) & rsTempA!gxgs4 & Chr(9) & rsTempA!gxmc5 & Chr(9) & rsTempA!gxgs5 & Chr(9) & rsTempA!gxmc6 & Chr(9) & rsTempA!gxgs6
griditem = griditem & Chr(9) & rsTempA!gxmc7 & Chr(9) & rsTempA!gxgs7 & Chr(9) & rsTempA!gxmc8 & Chr(9) & rsTempA!gxgs8 & Chr(9) & rsTempA!gxmc9 & Chr(9) & rsTempA!gxgs9
griditem = griditem & Chr(9) & rsTempA!gxmc10 & Chr(9) & rsTempA!gxgs10 & Chr(9) & rsTempA!gxmc11 & Chr(9) & rsTempA!gxgs11 & Chr(9) & rsTempA!gxmc12 & Chr(9) & rsTempA!gxgs12
griditem = griditem & Chr(9) & rsTempA!gxmc13 & Chr(9) & rsTempA!gxgs13 & Chr(9) & rsTempA!gxmc14 & Chr(9) & rsTempA!gxgs14 & Chr(9) & rsTempA!gxmc15 & Chr(9) & rsTempA!gxgs15
griditem = griditem & Chr(9) & rsTempA!ljqx & Chr(9) & rsTempA!ljbz
Grid1.AddItem griditem
rsTempA.MoveNext
Loop
'增加本部件零件增加时的项目显示于进度表栏目中
Set rsTempA = oDb.Execute("select max(ljbh) as maxljbh from ajdlj where bjbh='" & Left(cmbbj.Text, i - 1) & "'") '取件零件工时表中最大的零件编号，在零件表中找出大于此编号的项目填上
Set rsTempB = oDb.Execute("select * from alj where bjbh='" & Left(cmbbj.Text, i - 1) & "' and ljbh>'" & rsTempA!maxljbh & "' order by ljbh")
Do Until rsTempB.EOF
griditem = (rsTempB!code - 1) & Chr(9) & rsTempB!ljbh & Chr(9) & Trim(rsTempB!ljmc) & Chr(9) & Trim(rsTempB!ljth) & Chr(9) & rsTempB!ljsl
For j = 6 To Grid1.Cols - 3 Step 2
griditem = griditem & Chr(9) & "" & Chr(9) & ""
Next j
griditem = griditem & Chr(9) & rsTempB!ljqx & Chr(9) & rsTempB!ljbz
Grid1.AddItem griditem
rsTempB.MoveNext
Loop
'填入进度表工序工时小计数
Grid2.Cols = 2
Set rsTempA = oDb.Execute("select * from ajdbj where bjbh='" & lblbj(0).Caption & "'")
j = 2
Do Until rsTempA.EOF
Grid2.Cols = Grid2.Cols + 1
Grid2.Cell(0, j).Text = rsTempA!gxbh
Grid2.Cell(1, j).Text = rsTempA!gxmc
Grid2.Cell(2, j).Text = rsTempA!gxgs
rsTempA.MoveNext
Grid2.Column(j).Width = 40
j = j + 1
Loop
'合计数
Set rsTempA = oDb.Execute("select bjtotgs,bjdate1 from abj where bjbh='" & lblbj(0).Caption & "'")
If rsTempA!bjtotgs > 0 Then
Grid2.Cols = Grid2.Cols + 1
Grid2.Cell(1, Grid2.Cols - 1).Text = "总工时(H)"
Grid2.Cell(2, Grid2.Cols - 1).Text = rsTempA!bjtotgs
End If
If Not IsNull(rsTempA!bjdate1) Then Mskdate1.Text = rsTempA!bjdate1
Else
Set rsTempB = oDb.Execute("select * from alj where bjbh='" & Left(cmbbj.Text, i - 1) & "' order by code")
Do Until rsTempB.EOF
griditem = (rsTempB!code - 1) & Chr(9) & rsTempB!ljbh & Chr(9) & Trim(rsTempB!ljmc) & Chr(9) & Trim(rsTempB!ljth) & Chr(9) & rsTempB!ljsl
For j = 6 To Grid1.Cols - 3 Step 2
griditem = griditem & Chr(9) & "" & Chr(9) & ""
Next j
griditem = griditem & Chr(9) & rsTempB!ljqx & Chr(9) & rsTempB!ljbz
Grid1.AddItem griditem
rsTempB.MoveNext
Loop
Grid2.Cols = 2
'取得计划完成日期
Set rsTempB = oDb.Execute("select * from abj where bjbh='" & Left(cmbbj.Text, i - 1) & "'")
If Not IsNull(rsTempB!bjdate1) Then Mskdate1.Text = rsTempB!bjdate1
End If
MousePointer = vbDefault
End Sub
Private Sub dogridfirst()
Grid1.Cols = 38
Grid1.FixedRows = 1
Grid1.FixedCols = 6
Grid1.Rows = 2
Grid1.Column(0).Width = 2
Grid1.Column(1).Width = 20
Grid1.Column(2).Width = 2
Grid1.Column(3).Width = 100
Grid1.Column(4).Width = 100
Grid1.Column(5).Width = 30
For i = 6 To Grid1.Cols - 1
Grid1.Column(i).Width = 50
Next i
Grid1.Column(Grid1.Cols - 2).Width = 70
'Grid1.RowHeight(i) = 30
'表内容格式定义
Set rsTempC = oDb.Execute("select * from agx")
For j = 6 To Grid1.Cols - 3 Step 2
Grid1.Column(j).CellType = cellComboBox '工序列全部为下拉可选
Grid1.Column(j + 1).Alignment = cellLeftCenter
Grid1.Column(j + 1).Mask = CellValue '工时列右对齐，只能输入数字
rsTempC.MoveFirst '工序可选
Do Until rsTempC.EOF
Grid1.ComboBox(j).AddItem rsTempC!gxmc
rsTempC.MoveNext
Loop
Grid1.ComboBox(j).AddItem "--" '2006.8.14修改增加
Grid1.ComboBox(j).Locked = True
Next j
mskdate2.Text = NOWDate
MonthView2.Visible = False
MonthView2.Value = NOWDate
Set rsTempA = oDb.Execute("select * from acp where cpyn='Y'") '只显示需统计的产品Y
Do Until rsTempA.EOF
cmbcp.AddItem rsTempA!cpbh & "," & rsTempA!cpmc & "." & rsTempA!cpxh
rsTempA.MoveNext
Loop
cmbcp.ListIndex = 0
End Sub
Private Sub dogridfill()
'填列表头内容
Grid1.Cell(0, 1).Text = "序号"
Grid1.Cell(0, 2).Text = "零件编号"
Grid1.Cell(0, 3).Text = "零件名称"
Grid1.Cell(0, 4).Text = "图号"
Grid1.Cell(0, 5).Text = "数量"
For i = 6 To Grid1.Cols - 3 Step 2
Grid1.Cell(0, i).Text = "工序"
Grid1.Cell(0, i + 1).Text = "工时(分)"
Next i
Grid1.Cell(0, Grid1.Cols - 2).Text = "零件去向"
Grid1.Cell(0, Grid1.Cols - 1).Text = "备注"
Grid1.Rows = 1
End Sub
Private Sub dogridfill2()
'填列表头内容
Grid2.Rows = 3
Grid2.FixedCols = 2
Grid2.Column(0).Width = 5
Grid2.Cell(0, 1).Text = "工序编号"
Grid2.Cell(1, 1).Text = "工序名称"
Grid2.Cell(2, 1).Text = "工时小计H"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -