📄 prnscjd.frm
字号:
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 3660
TabIndex = 10
Top = 720
Width = 1275
End
Begin VB.Label lblsl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Left = 7980
TabIndex = 9
Top = 1560
Width = 1035
End
Begin VB.Label lblzl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 315
Left = 10620
TabIndex = 8
Top = 1560
Width = 1035
End
Begin VB.Label Label1
Caption = "请选择："
Height = 195
Index = 14
Left = 60
TabIndex = 7
Top = 420
Width = 795
End
End
Attribute VB_Name = "prnscjd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Colsgrid3 As Integer '表3列数
Private Sub Form_Load()
Me.Width = 12000: Me.Height = 8500
Grid1.AllowUserResizing = False
Grid1.DisplayFocusRect = False
dogridfirst '表单样式
dogridfill '表单格式内容
Grid1.AutoRedraw = True
Grid1.Refresh
Grid2.RowHeight(0) = 2
dogridfill2
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()
'选取部件后，相应零件信息填入进度表表格。
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
If rsTempA!gxgs1 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc1 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc1 & Chr(9) & rsTempA!gxgs1
If rsTempA!gxgs2 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc2 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc2 & Chr(9) & rsTempA!gxgs2
If rsTempA!gxgs3 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc3 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc3 & Chr(9) & rsTempA!gxgs3
If rsTempA!gxgs4 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc4 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc4 & Chr(9) & rsTempA!gxgs4
If rsTempA!gxgs5 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc5 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc5 & Chr(9) & rsTempA!gxgs5
If rsTempA!gxgs6 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc6 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc6 & Chr(9) & rsTempA!gxgs6
If rsTempA!gxgs7 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc7 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc7 & Chr(9) & rsTempA!gxgs7
If rsTempA!gxgs8 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc8 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc8 & Chr(9) & rsTempA!gxgs8
If rsTempA!gxgs9 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc9 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc9 & Chr(9) & rsTempA!gxgs9
If rsTempA!gxgs10 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc10 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc10 & Chr(9) & rsTempA!gxgs10
If rsTempA!gxgs11 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc11 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc11 & Chr(9) & rsTempA!gxgs11
If rsTempA!gxgs12 = 0 Then griditem = griditem & Chr(9) & rsTempA!gxmc12 & Chr(9) & "" Else griditem = griditem & Chr(9) & rsTempA!gxmc12 & Chr(9) & rsTempA!gxgs12
griditem = griditem & Chr(9) & rsTempA!ljqx & Chr(9) & rsTempA!ljbz
Grid1.AddItem griditem
rsTempA.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
End If
End Sub
Private Sub dogridfirst()
Grid1.Cols = 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
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
Private Sub dogridfill3()
Colsgrid3 = Grid1.Cols - 1
Grid3.Cols = Colsgrid3
Grid3.Rows = 5
Grid3.Range(1, 1, 1, Colsgrid3 - 1).Merge
Grid3.Cell(1, 1).Text = "生 产 进 度 表"
Grid3.Column(1).Alignment = cellGeneralCenter
Grid3.Rows = Grid3.Rows + 1
Grid3.Range(3, 1, 3, Colsgrid3 - 1).Merge
Grid3.Cell(3, 1).Text = " 产品名称型号:" & Trim(lblcp(1).Caption) & Trim(lblcp(2).Caption) & " 部件名称：" & lblbj(1).Caption & " 图号:" & lblbj(2).Caption & " 数量:" & lblsl.Caption & " 重量：" & lblzl.Caption & " 计划完成日期：" & Mskdate1.Text & " 订货单位：" & lbldh(1).Caption
For i = 0 To Grid1.Rows - 1
Grid3.Rows = Grid3.Rows + 1
For j = 2 To Grid1.Cols - 1
Grid3.Cell(i + 4, 1).Text = i '序 号
Grid3.Cell(i + 4, j - 1).Text = Grid1.Cell(i, j).Text
Next j
Next i
For i = 1 To Grid2.Rows - 1
Grid3.Rows = Grid3.Rows + 1
For j = 1 To Grid2.Cols - 1
Grid3.Cell(Grid3.Rows - 1, j + 1).Text = Grid2.Cell(i, j).Text
Next j
Next i
End Sub
Private Sub cmdexcel_Click()
Dim irowNo As Integer, sRange As String
dogridfill3 '填充到表3
If excelsetup = False Then
Set mobjexcel = CreateObject("Excel.application") '启动excel 在 Form load ()过程
End If
Me.MousePointer = vbHourglass
excelsetup = True
'StatusBar1.SimpleText = " 正在启动Excel，并给 Excel工作表 填充数据，请稍等！"
With mobjexcel '添加工作表
.workbooks.Add
End With
With mobjexcel '设置工作表字体，列宽
.ActiveCell.Columns("A:A").ColumnWidth = 3
.ActiveCell.Columns("B:B").ColumnWidth = 10
.ActiveCell.Columns("C:C").ColumnWidth = 12
.ActiveCell.Columns("D:D").ColumnWidth = 4
.ActiveCell.Columns("E:E").ColumnWidth = 6
.ActiveCell.Columns("F:F").ColumnWidth = 6
.ActiveCell.Columns("G:G").ColumnWidth = 6
.ActiveCell.Columns("H:H").ColumnWidth = 6
.ActiveCell.Columns("I:I").ColumnWidth = 6
.ActiveCell.Columns("J:J").ColumnWidth = 6
.ActiveCell.Columns("K:K").ColumnWidth = 6
.ActiveCell.Columns("L:L").ColumnWidth = 6
.ActiveCell.Columns("M:M").ColumnWidth = 6
.ActiveCell.Columns("N:N").ColumnWidth = 6
.ActiveCell.Columns("O:O").ColumnWidth = 6
.ActiveCell.Columns("P:P").ColumnWidth = 6
.ActiveCell.Columns("Q:Q").ColumnWidth = 6
.ActiveCell.Columns("R:R").ColumnWidth = 6
.ActiveCell.Columns("S:S").ColumnWidth = 6
.ActiveCell.Columns("T:T").ColumnWidth = 6
.ActiveCell.Columns("U:U").ColumnWidth = 6
.ActiveCell.Columns("V:V").ColumnWidth = 6
.ActiveCell.Columns("W:W").ColumnWidth = 6
.ActiveCell.Columns("X:X").ColumnWidth = 6
.ActiveCell.Columns("Y:Y").ColumnWidth = 6
.ActiveCell.Columns("Z:Z").ColumnWidth = 6
.ActiveCell.Columns("AA:AA").ColumnWidth = 6
.ActiveCell.Columns("AB:AB").ColumnWidth = 6
.ActiveCell.Columns("AC:AC").ColumnWidth = 6
.ActiveCell.Columns("AD:AD").ColumnWidth = 6
End With
irowNo = 1 'Excel row
mobjexcel.Visible = True 'Excel visible
' With mobjexcel
' .ActiveCell.Cells(irowNo, 1).Value = "日期"
' .ActiveCell.Cells(irowNo, 2).Value = " 余额"
'
' End With
For irowNo = 1 To Grid3.Rows - 1
For j = 1 To Grid3.Cols - 1
With mobjexcel
.ActiveCell.Cells(irowNo + 1, j).Value = Grid3.Cell(irowNo, j).Text
End With
Next j
Next irowNo
With mobjexcel '设置工作表字体，列宽
'sRange = Chr(Asc("A")) & "5" & ":" & Chr(Asc("Z")) & irowNo
sRange = "(" & "A5:AD" & irowNo & ")"
.Range(sRange).Select '设置范围
.Selection.RowHeight = 16 'Excel行高
.Selection.Font.Name = "宋体" 'Excel 字体
.Selection.Font.Size = 9 'Excel 字号
.Selection.Borders.LineStyle = tvwRootLines '画边框线
End With
'StatusBar1.SimpleText = " Excel工作表 数据填充完毕，可按需要对 Excel工作表进行操作！"
Me.MousePointer = vbDefault
excelsetup = True
'打印设置
With mobjexcel '定义页眉、页尾
.ActiveSheet.PageSetup.LeftHeader = ""
'.ActiveSheet.PageSetup.CenterHeader = "海亮集团 "
'.ActiveSheet.PageSetup.RightHeader = curdate2 & " "
'.ActiveSheet.PageSetup.PaperSize = vbPRPSA4 'A4 纸纵向打印
.ActiveCell.Range("A1").Select '焦点行 取消黑框
End With
End Sub
Private Sub cmdexit_Click()
If excelsetup = True Then
mobjexcel.activeworkbook.saved = True '放弃对工作表的改变
excelsetup = False
mobjexcel.Quit
End If
Set mobjexcel = Nothing
'Set oDb = Nothing
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -