📄 prncpbjlx.frm
字号:
Top = 720
Width = 1515
End
Begin VB.Label lblcp
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 1
Left = 5820
TabIndex = 7
Top = 720
Width = 1455
End
Begin VB.Label lblbj
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 3780
TabIndex = 6
Top = 1140
Width = 1275
End
Begin VB.Label lblcp
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 3780
TabIndex = 5
Top = 720
Width = 1275
End
Begin VB.Label lblsl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Left = 7080
TabIndex = 4
Top = 1560
Width = 555
End
Begin VB.Label Label1
Caption = "编号："
Height = 195
Index = 13
Left = 9960
TabIndex = 3
Top = 180
Width = 555
End
Begin VB.Label Label1
Caption = "请选择："
Height = 195
Index = 14
Left = 180
TabIndex = 2
Top = 420
Width = 795
End
End
Attribute VB_Name = "prncpbjlx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'点击表一零件后，在表2中填列相关路线单，再打印表2
Option Explicit
Dim currow As Integer
Private Sub Form_Load()
Me.Width = 12000: Me.Height = 8500
Grid1.AllowUserResizing = False
Grid1.DisplayFocusRect = False
Grid1.ExtendLastCol = True
dogridfirst '表单样式
dogridfill1 '表单格式内容
Grid1.AutoRedraw = True
Grid1.Refresh
End Sub
Private Sub cmdpreview_Click()
Grid2.PrintPreview
End Sub
Private Sub cmdprint_Click()
On Error GoTo ErrorHandler
Grid2.DirectPrint
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation
Resume Next
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdPageSetup_Click()
Call ShowPageSetup(Grid2)
End Sub
Private Sub cmdfind_Click()
'填列打印表2
Grid2.Rows = 2
currow = Grid1.ActiveCell.Row
Grid1.Range(currow, 6, currow, Grid1.Cols - 1).BackColor = vbRed
dogridfill2
Grid2.Range(1, 1, Grid2.Rows - 1, Grid2.Cols - 1).FontSize = 9 '11
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
Mskdate1.Text = rsTempB!bjdate1
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 & 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 & 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
End If
Set rsTempB = oDb.Execute("select * from abj where bjbh='" & lblbj(0).Caption & "'")
If Not IsNull(rsTempB!bjdate1) Then Mskdate1.Text = rsTempB!bjdate1
'MousePointer = vbDefault
End Sub
Private Sub dogridfirst()
Grid1.Cols = 38 '32
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 + 1).Alignment = cellLeftCenter
Next j
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
Grid2.Cols = 17
Grid2.Column(0).Width = 2
Grid2.Column(1).Width = 30
Grid2.Column(2).Width = 60
Grid2.Column(3).Width = 55
Grid2.Column(4).Width = 50
For i = 5 To 16
Grid2.Column(i).Width = 60
Next i
End Sub
Private Sub dogridfill1()
'填列表头内容
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 = 23
Grid2.RowHeight(1) = 1
For i = 2 To 6
Grid2.RowHeight(i) = 28
Next i
For i = 7 To 22
Grid2.RowHeight(i) = 30
Next i
Grid2.Cell(1, 1).Text = ""
Grid2.Range(2, 3, 2, 4).Merge
Grid2.Cell(2, 3).Text = lblcp(1).Caption '产品名称
Grid2.Range(2, 6, 2, 8).Merge
Grid2.Cell(2, 6).Text = " " & lblbj(1).Caption '部件名称
Grid2.Range(2, 9, 2, 11).Merge
Grid2.Cell(2, 9).Text = " " & lblbj(2).Caption '部件型号
Grid2.Cell(2, 12).Text = lblsl.Caption '数量
Grid2.Range(2, 15, 2, 16).Merge
Grid2.Cell(2, 15).Text = " " & lbldh(1).Caption '单位名称
Grid2.Range(4, 1, 4, 2).Merge
Grid2.Cell(4, 1).Text = Grid1.Cell(currow, 1).Text '进度表序号
Grid2.Range(4, 3, 4, 4).Merge
Grid2.Cell(4, 3).Text = " " & Grid1.Cell(currow, 3).Text '零件名称
Grid2.Range(4, 5, 4, 7).Merge
Grid2.Cell(4, 5).Text = " " & Grid1.Cell(currow, 4).Text '零件图号
Grid2.Cell(4, 8).Text = " " & Grid1.Cell(currow, 5).Text
Grid2.Range(4, 11, 4, 13).Merge
Grid2.Cell(4, 11).Text = " " & NOWDate '投入日期为当前日
Grid2.Range(4, 14, 4, 15).Merge
Grid2.Cell(4, 14).Text = Mskdate1.Text '计划完成日期
Grid2.Cell(4, 16).Text = Grid1.Cell(currow, Grid1.Cols - 2).Text '零件去向
Grid2.Cell(7, 16).Text = Grid1.Cell(currow, Grid1.Cols - 1).Text '备注
'
Grid2.Range(5, 3, 5, 14).Merge
Grid2.Cell(5, 3).Text = "" '加工路线
For i = 6 To Grid1.Cols - 3 Step 2
If Trim(Grid1.Cell(currow, i).Text) <> "" Then
Grid2.Cell(i / 2 + 5, 1).Text = i / 2 - 2
Grid2.Cell(i / 2 + 5, 2).Text = Grid1.Cell(currow, i).Text
Grid2.Cell(i / 2 + 5, 3).Text = Grid1.Cell(currow, i + 1).Text
Else
Exit For
End If
Next i
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -