plancjsc.frm

一个机械产品（产品、部件、零件）的工时、工资及进度软件

    For i = 9 To Grid1.Cols - 1    '数据右对齐
        Grid1.Column(i).Alignment = cellRightCenter
    Next i
    
    i = 12
    Do Until rsTempC.EOF
        Grid1.Range(0, i, 0, i + 1).Merge
        Grid1.Cell(0, i).Text = rsTempC!gxmc
        Grid1.Cell(1, i).Text = "定额"
        Grid1.Cell(1, i + 1).Text = "计划"
        Grid1.Column(i).Width = 40
        Grid1.Column(i + 1).Width = 40
        rsTempC.MoveNext
        i = i + 2
    Loop
    Grid1.Range(0, i, 1, i).Merge
    Grid1.Cell(0, i).Text = "小计工时"
    Grid1.Column(i).Width = 50
    Grid1.Column(i).Alignment = cellRightCenter

    Set rsTempA = oDb.Execute("select * from acp where cpyn='Y' order by cpbh")
    barcount = rsTempA.RecordCount
    barvalue = 1
    Do Until rsTempA.EOF
 
        ProgressBar1.Value = barvalue / barcount * 100
        '填序号＋产品名称＋产品型号
        griditem = (Grid1.Rows - 1) & Chr(9) & Trim(rsTempA!dhmc) & Chr(9) & Trim(rsTempA!cpmc) & Chr(9) & Trim(rsTempA!cpxh)
        Grid1.AddItem griditem
        Grid1.Range(Grid1.Rows - 1, 2, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = vbGreen     '产品行底色为green
        '部件
        Set rsTempB = oDb.Execute("select * from abj where cpbh='" & rsTempA!cpbh & "' order by bjbh")
        barcount2 = rsTempB.RecordCount
        barvalue2 = 1
        Do Until rsTempB.EOF
            ProgressBar2.Value = barvalue2 / barcount2 * 100
            griditem = (Grid1.Rows - 1) & Chr(9) & Trim(rsTempA!dhmc) & Chr(9) & Trim(rsTempA!cpmc) & Chr(9) & Trim(rsTempA!cpxh) & Chr(9) & Trim(rsTempB!bjmc) & Chr(9) & Trim(rsTempB!bjth) & Chr(9) & "" & Chr(9) & "" & Chr(9) & rsTempB!bjsl & Chr(9) & rsTempB!bjzl
            Grid1.AddItem griditem
            Grid1.Range(Grid1.Rows - 1, 2, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = &HC0FFC0           '部件行底色为blue
            '零件
            Set rsTempC = oDb.Execute("select * from alj where bjbh='" & rsTempB!bjbh & "' order by ljbh")
            Do Until rsTempC.EOF
                    '先在零件工时表(ajdlj)中汇总零件工时数，再填入
                Gsdn = 0
                Set rsTempD = oDb.Execute("select * from ajdlj where ljbh='" & rsTempC!ljbh & "'")
                If rsTempD.RecordCount > 0 Then
                    For i = 6 To 41 Step 3
                        mc(i / 3 - 1) = rsTempD.Fields(i + 1).Value
                        gs(i / 3 - 1) = rsTempD.Fields(i + 2).Value
                        Gsdn = Gsdn + gs(i / 3 - 1)
                    Next i
                Else
                    For i = 6 To 41 Step 3
                        mc(i / 3 - 1) = ""
                        gs(i / 3 - 1) = 0
                        Gsdn = 0
                    Next i
                End If
                
                    '零件名称+型号+数量+重量+ 定额工时(全部)
                griditem = (Grid1.Rows - 1) & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & Trim(rsTempB!bjmc) & Chr(9) & Trim(rsTempB!bjth) & Chr(9) & Trim(rsTempC!ljmc) & Chr(9) & Trim(rsTempC!ljth) & Chr(9) & rsTempC!ljsl & Chr(9) & rsTempC!ljzl
                griditem = griditem & Chr(9) & Round(Gsdn / 60, 1) ' & Chr(9) & Tempgs
                
                subgs = 0
                    '单工序在进度表上的定额工时数/60
                For i = 12 To Grid1.Cols - 2 Step 2
                    mc(0) = Grid1.Cell(0, i).Text
                    Select Case mc(0)
                        Case mc(1)
                            griditem = griditem & Chr(9) & Round(gs(1) / 60, 1)
                            Tempgs = Round(gs(1) / 60, 1)
                        Case mc(2)
                            griditem = griditem & Chr(9) & Round(gs(2) / 60, 1)
                            Tempgs = Round(gs(2) / 60, 1)
                        Case mc(3)
                            griditem = griditem & Chr(9) & Round(gs(3) / 60, 1)
                            Tempgs = Round(gs(3) / 60, 1)
                        Case mc(4)
                            griditem = griditem & Chr(9) & Round(gs(4) / 60, 1)
                            Tempgs = Round(gs(4) / 60, 1)
                        Case mc(5)
                            griditem = griditem & Chr(9) & Round(gs(5) / 60, 1)
                            Tempgs = Round(gs(5) / 60, 1)
                        Case mc(6)
                            griditem = griditem & Chr(9) & Round(gs(6) / 60, 1)
                            Tempgs = Round(gs(6) / 60, 1)
                        Case mc(7)
                            griditem = griditem & Chr(9) & Round(gs(7) / 60, 1)
                            Tempgs = Round(gs(7) / 60, 1)
                        Case mc(8)
                            griditem = griditem & Chr(9) & Round(gs(8) / 60, 1)
                            Tempgs = Round(gs(8) / 60, 1)
                        Case mc(9)
                            griditem = griditem & Chr(9) & Round(gs(9) / 60, 1)
                            Tempgs = Round(gs(9) / 60, 1)
                        Case mc(10)
                            griditem = griditem & Chr(9) & Round(gs(10) / 60, 1)
                            Tempgs = Round(gs(10) / 60, 1)
                        Case mc(11)
                            griditem = griditem & Chr(9) & Round(gs(11) / 60, 1)
                            Tempgs = Round(gs(11) / 60, 1)
                        Case mc(12)
                            griditem = griditem & Chr(9) & Round(gs(12) / 60, 1)
                            Tempgs = Round(gs(12) / 60, 1)
                        Case Else
                            griditem = griditem & Chr(9) & ""
                            Tempgs = 0
                    End Select
                    '定额工票本零件本工序已完成的合计数
                    szSql = "select sum(gpgs) as sumgpgs from gpdnh,gpdnb where (gpdnh.gpbh=gpdnb.gpbh) and gpdnh.gprq<='" & curdate1 & "' and gpdnb.gpljbh='" & rsTempC!ljbh & "' and gpdnb.gpgxmc='" & mc(0) & "'"
                    Set rsTempD = oDb.Execute(szSql)
                    If Not IsNull(rsTempD!sumgpgs) Then
                        griditem = griditem & Chr(9) & (Tempgs - Round(rsTempD!sumgpgs / 60, 1))  '定额-实现完成总数=计划数
                        subgs = subgs + (Tempgs - Round(rsTempD!sumgpgs / 60, 1))
                        Else
                        If Tempgs <> 0 Then   '0不显示
                            griditem = griditem & Chr(9) & Tempgs
                            subgs = subgs + Tempgs
                            Else
                            griditem = griditem & Chr(9) & ""
                        End If
                    End If
                Next i
               
                Grid1.AddItem griditem & Chr(9) & subgs
                txtrows.Text = Grid1.Rows - 1
                txtrows.Refresh
                
                rsTempC.MoveNext
            Loop
            rsTempB.MoveNext
            barvalue2 = barvalue2 + 1
        Loop
        rsTempA.MoveNext
        barvalue = barvalue + 1
        DoEvents
    Loop
End Sub
Private Sub dogridfill()
    Grid1.Range(0, 1, 1, 1).Merge
    Grid1.Range(0, 2, 1, 2).Merge
    Grid1.Range(0, 3, 1, 3).Merge
    Grid1.Range(0, 4, 1, 4).Merge
    Grid1.Range(0, 5, 1, 5).Merge
    Grid1.Range(0, 6, 1, 6).Merge
    Grid1.Range(0, 7, 1, 7).Merge
    Grid1.Range(0, 8, 1, 8).Merge
    Grid1.Range(0, 9, 1, 9).Merge
    Grid1.Range(0, 10, 1, 10).Merge
    Grid1.Range(0, 11, 1, 11).Merge
    Grid1.Cell(0, 11).WrapText = True   ' 单元格自动换行
    
    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 = "部件名称"
    Grid1.Cell(0, 6).Text = "部件型号"
    Grid1.Cell(0, 7).Text = "零件名称"
    Grid1.Cell(0, 8).Text = "零件图号"
    Grid1.Cell(0, 9).Text = "数量"
    Grid1.Cell(0, 10).Text = "重量"
    Grid1.Cell(0, 11).Text = "定额工时(全部)"
End Sub
 
Private Sub cmdexcel_Click()
    Dim irowNo As Integer, sRange As String
    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 = 6
        .ActiveCell.Columns("C:C").ColumnWidth = 8
        .ActiveCell.Columns("D:D").ColumnWidth = 8
        .ActiveCell.Columns("E:E").ColumnWidth = 8
        .ActiveCell.Columns("F:F").ColumnWidth = 8
        .ActiveCell.Columns("G:G").ColumnWidth = 8
        .ActiveCell.Columns("H:H").ColumnWidth = 8
        .ActiveCell.Columns("I:I").ColumnWidth = 4
        .ActiveCell.Columns("J:J").ColumnWidth = 4
        .ActiveCell.Columns("K:K").ColumnWidth = 4
        .ActiveCell.Columns("L:L").ColumnWidth = 4
        .ActiveCell.Columns("M:M").ColumnWidth = 4
        .ActiveCell.Columns("N:N").ColumnWidth = 4
        .ActiveCell.Columns("O:O").ColumnWidth = 4
        .ActiveCell.Columns("P:P").ColumnWidth = 4
        .ActiveCell.Columns("Q:Q").ColumnWidth = 4
        .ActiveCell.Columns("R:R").ColumnWidth = 4
        .ActiveCell.Columns("S:S").ColumnWidth = 4
        .ActiveCell.Columns("T:T").ColumnWidth = 4
        .ActiveCell.Columns("U:U").ColumnWidth = 4
        .ActiveCell.Columns("V:V").ColumnWidth = 4
        .ActiveCell.Columns("W:W").ColumnWidth = 4
        .ActiveCell.Columns("X:X").ColumnWidth = 4
        .ActiveCell.Columns("Y:Y").ColumnWidth = 4
        .ActiveCell.Columns("Z:Z").ColumnWidth = 4
        .ActiveCell.Columns("AA:AA").ColumnWidth = 4
        .ActiveCell.Columns("AB:AB").ColumnWidth = 4
        .ActiveCell.Columns("AC:AC").ColumnWidth = 4
        .ActiveCell.Columns("AD:AD").ColumnWidth = 4
        .ActiveCell.Columns("AE:AE").ColumnWidth = 4
        .ActiveCell.Columns("AF:AF").ColumnWidth = 4
        .ActiveCell.Columns("AG:AG").ColumnWidth = 4
        .ActiveCell.Columns("AH:AH").ColumnWidth = 4
        .ActiveCell.Columns("AI:AI").ColumnWidth = 4
        .ActiveCell.Columns("AJ:AJ").ColumnWidth = 4
        .ActiveCell.Columns("AK:AK").ColumnWidth = 4
        .ActiveCell.Columns("AL:AL").ColumnWidth = 4
        .ActiveCell.Columns("AM:AM").ColumnWidth = 4
        .ActiveCell.Columns("AN:AN").ColumnWidth = 4
    End With

    'irowNo = 1                  'Excel row
    mobjexcel.Visible = True    'Excel visible
    
    With mobjexcel
        .ActiveCell.Cells(1, 1).Value = "绍兴金氏机械设备有限公司  车间生产计划表"
        .ActiveCell.Cells(3, 1).Value = "计划年月：" & txtym.Text & Space(10) & "车间名称：" & cmbcj.Text & Space(20) & "单位：" & Label1(1).Caption
    End With
    
    For irowNo = 0 To Grid1.Rows - 1
            For j = 1 To Grid1.Cols - 1
                With mobjexcel
                    .ActiveCell.Cells(irowNo + 4, j).Value = Grid1.Cell(irowNo, j).Text
                End With
            Next j
    Next irowNo

    With mobjexcel        '设置工作表字体，列宽
        'sRange = Chr(Asc("A")) & "2" & ":" & Chr(Asc("AL")) & irowNo
        sRange = "(" & "A4:AN" & (irowNo + 3) & ")"
        .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
    Unload Me
End Sub