⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gpindnfind.frm

📁 一个机械产品(产品、部件、零件)的工时、工资及进度软件
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    MSGrid1.ColWidth(12) = MSGrid1.Width * 0.05
    MSGrid1.ColWidth(13) = MSGrid1.Width * 0.08: MSGrid1.ColWidth(14) = MSGrid1.Width * 0.08
    MSGrid1.ColWidth(15) = MSGrid1.Width * 0.08: MSGrid1.ColWidth(16) = MSGrid1.Width * 0.08
    MSGrid1.ColWidth(17) = MSGrid1.Width * 0.1
     
    Set rsTempA = oDb.Execute("select * from acj")
    Do Until rsTempA.EOF
        cmbcj.AddItem rsTempA!cjmc
        rsTempA.MoveNext
    Loop
    
    Mskdate1.Text = NOWDate
    MonthView1.Visible = False
    MonthView1.Value = NOWDate
    mskdate2.Text = NOWDate
    MonthView2.Visible = False
    MonthView2.Value = NOWDate
    
    optdn.Value = True
End Sub
Private Sub cmdfind_Click()
    Totgs = 0
    If optdn.Value = True Then '定额工票
        griditem = "select * from gpdnh where "
        If Mskdate1.Text = "" Then
            griditem = griditem & "gprq >='" & (NOWDate - 30) & "'"
        Else
            griditem = griditem & "gprq >='" & (Mskdate1.Text) & "'"
        End If
            
        If mskdate2.Text = "" Then
            griditem = griditem & "and gprq <='" & (NOWDate) & "'"
        Else
            griditem = griditem & "and gprq <='" & (mskdate2.Text) & "'"
        End If
        
        If txtgpbh1.Text <> "" Then griditem = griditem & " and gphm >='" & txtgpbh1.Text & "'"
        If txtgpbh2.Text <> "" Then griditem = griditem & " and gphm <='" & txtgpbh2.Text & "'"
        If cmbcj.Text <> "" Then griditem = griditem & " and gpcjmc = '" & cmbcj.Text & "'"
        If cmbbz.Text <> "" Then griditem = griditem & " and gpbzmc ='" & cmbbz.Text & "'"
         
        Set rsTempA = oDb.Execute(griditem)
        i = 1
        MSGrid1.Rows = 1
        MSGrid1.ColWidth(5) = MSGrid1.Width * 0.001
        Do Until rsTempA.EOF
            griditem = rsTempA!gpbh & Chr(9) & rsTempA!gphm & Chr(9) & rsTempA!gpcjmc & Chr(9) & rsTempA!gpbzmc & Chr(9) & ""
            '产品名称、部件名称
            Set rsTempB = oDb.Execute("select * from acp where cpbh='" & rsTempA!gpcpbh & "'")
            griditem = griditem & Chr(9) & rsTempB!dhmc & Chr(9) & rsTempB!cpmc
            Set rsTempB = oDb.Execute("select * from abj where bjbh='" & rsTempA!gpbjbh & "'")
            griditem = griditem & Chr(9) & rsTempB!bjmc
            
            Set rsTempB = oDb.Execute("select * from gpdnb where gpbh='" & rsTempA!gpbh & "'")
            Do Until rsTempB.EOF
                griditem1 = rsTempB!gpljbh & Chr(9) & rsTempB!gpljmc & Chr(9) & rsTempB!gpljth & Chr(9) & rsTempB!gpsl & Chr(9) & rsTempB!gpgxmc & Chr(9) & rsTempB!gpgs & Chr(9) & rsTempB!gpbz & Chr(9) & rsTempB!gpbz1 & Chr(9) & rsTempB!gpbz2
                MSGrid1.AddItem i & Chr(9) & griditem & Chr(9) & griditem1
                Totgs = Totgs + rsTempB!gpgs
                i = i + 1
                rsTempB.MoveNext
            Loop
            rsTempA.MoveNext
        Loop
        MSGrid1.AddItem "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "合计工时" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & Totgs
    End If
    If optzp.Value = True Then '增拨工票
        griditem = "select * from gpzph where "
        If Mskdate1.Text = "" Then
            griditem = griditem & "gprq >='" & (NOWDate - 30) & "'"
        Else
            griditem = griditem & "gprq >='" & (Mskdate1.Text) & "'"
        End If
            
        If mskdate2.Text = "" Then
            griditem = griditem & " and gprq <='" & (NOWDate) & "'"
        Else
            griditem = griditem & " and gprq <='" & (mskdate2.Text) & "'"
        End If
        
        If txtgpbh1.Text <> "" Then griditem = griditem & " and gphm >='" & txtgpbh1.Text & "'"
        If txtgpbh2.Text <> "" Then griditem = griditem & " and gphm <='" & txtgpbh2.Text & "'"
        If cmbcj.Text <> "" Then griditem = griditem & " and gpcjmc = '" & cmbcj.Text & "'"
        If cmbbz.Text <> "" Then griditem = griditem & " and gpbzmc ='" & cmbbz.Text & "'"
         
        Set rsTempA = oDb.Execute(griditem)
        i = 1
        MSGrid1.Rows = 1
        MSGrid1.ColWidth(5) = MSGrid1.Width * 0.1
        Do Until rsTempA.EOF
            griditem = rsTempA!gpbh & Chr(9) & rsTempA!gphm & Chr(9) & rsTempA!gpcjmc & Chr(9) & rsTempA!gpbzmc & Chr(9) & rsTempA!gpgslb
            
            '产品名称、部件名称
            Set rsTempB = oDb.Execute("select * from acp where cpbh='" & rsTempA!gpcpbh & "'")
            griditem = griditem & Chr(9) & rsTempB!dhmc & Chr(9) & rsTempB!cpmc
            Set rsTempB = oDb.Execute("select * from abj where bjbh='" & rsTempA!gpbjbh & "'")
            griditem = griditem & Chr(9) & rsTempB!bjmc
            
            Set rsTempB = oDb.Execute("select * from gpzpb where gpbh='" & rsTempA!gpbh & "'")
            Do Until rsTempB.EOF
                griditem1 = rsTempB!gpljbh & Chr(9) & rsTempB!gpljmc & Chr(9) & rsTempB!gpljth & Chr(9) & rsTempB!gpsl & Chr(9) & rsTempB!gpgxmc & Chr(9) & rsTempB!gpgs & Chr(9) & rsTempB!gpbz & Chr(9) & rsTempB!gpbz1 & Chr(9) & rsTempB!gpbz2
                MSGrid1.AddItem i & Chr(9) & griditem & Chr(9) & griditem1
                Totgs = Totgs + rsTempB!gpgs
                i = i + 1
                rsTempB.MoveNext
            Loop
            rsTempA.MoveNext
        Loop
        MSGrid1.AddItem "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "合计工时" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & Totgs

    End If
    
    If optwx.Value = True Then '外协工票
        griditem = "select * from gpwxh where "
        If Mskdate1.Text = "" Then
            griditem = griditem & "gprq >='" & (NOWDate - 30) & "'"
        Else
            griditem = griditem & "gprq >='" & (Mskdate1.Text) & "'"
        End If
            
        If mskdate2.Text = "" Then
            griditem = griditem & "and gprq <='" & (NOWDate) & "'"
        Else
            griditem = griditem & "and gprq <='" & (mskdate2.Text) & "'"
        End If
        
        If txtgpbh1.Text <> "" Then griditem = griditem & " and gphm >='" & txtgpbh1.Text & "'"
        If txtgpbh2.Text <> "" Then griditem = griditem & " and gphm <='" & txtgpbh2.Text & "'"
        If cmbcj.Text <> "" Then griditem = griditem & " and gpcjmc = '" & cmbcj.Text & "'"
        If cmbbz.Text <> "" Then griditem = griditem & " and gpbzmc ='" & cmbbz.Text & "'"
         
        Set rsTempA = oDb.Execute(griditem)
        i = 1
        MSGrid1.Rows = 1
        MSGrid1.ColWidth(5) = MSGrid1.Width * 0.001
        Do Until rsTempA.EOF
            griditem = rsTempA!gpbh & Chr(9) & rsTempA!gphm & Chr(9) & rsTempA!gpcjmc & Chr(9) & rsTempA!gpbzmc & Chr(9) & ""
            '产品名称、部件名称
            Set rsTempB = oDb.Execute("select * from acp where cpbh='" & rsTempA!gpcpbh & "'")
            griditem = griditem & Chr(9) & rsTempB!dhmc & Chr(9) & rsTempB!cpmc
            Set rsTempB = oDb.Execute("select * from abj where bjbh='" & rsTempA!gpbjbh & "'")
            griditem = griditem & Chr(9) & rsTempB!bjmc
            
            Set rsTempB = oDb.Execute("select * from gpwxb where gpbh='" & rsTempA!gpbh & "'")
            Do Until rsTempB.EOF
                griditem1 = rsTempB!gpljbh & Chr(9) & rsTempB!gpljmc & Chr(9) & rsTempB!gpljth & Chr(9) & rsTempB!gpsl & Chr(9) & rsTempB!gpgxmc & Chr(9) & rsTempB!gpgs & Chr(9) & rsTempB!gpbz & Chr(9) & rsTempB!gpbz1 & Chr(9) & rsTempB!gpbz2
                MSGrid1.AddItem i & Chr(9) & griditem & Chr(9) & griditem1
                Totgs = Totgs + rsTempB!gpgs
                i = i + 1
                rsTempB.MoveNext
            Loop
            rsTempA.MoveNext
        Loop
        MSGrid1.AddItem "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "合计工时" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & Totgs
    End If
End Sub
Private Sub cmbcj_LostFocus()
    cmbbz.Clear
    Set rsTempA = oDb.Execute("select * from abz where cjmc='" & cmbcj.Text & "'")
    Do Until rsTempA.EOF
        cmbbz.AddItem rsTempA!bzmc
        rsTempA.MoveNext
    Loop
End Sub

Private Sub dofillgrid()
   MSGrid1.Row = 0
   MSGrid1.Col = 0: MSGrid1.Text = "序号"
   MSGrid1.Col = 1: MSGrid1.Text = "工票编号"    '前8位即日期
   MSGrid1.Col = 2: MSGrid1.Text = "工票号码"
   MSGrid1.Col = 3: MSGrid1.Text = " 车间名称"
   MSGrid1.Col = 4: MSGrid1.Text = "班组/个人"
   MSGrid1.Col = 5: MSGrid1.Text = "工票类别"
   
   MSGrid1.Col = 6: MSGrid1.Text = "订货单位"
   MSGrid1.Col = 7: MSGrid1.Text = "产品名称"
   MSGrid1.Col = 8: MSGrid1.Text = "部件名称"
   
   MSGrid1.Col = 9: MSGrid1.Text = "零件编号"
   MSGrid1.Col = 10: MSGrid1.Text = "零件名称"
   MSGrid1.Col = 11: MSGrid1.Text = "零件图号"
   MSGrid1.Col = 12: MSGrid1.Text = "数量"
   MSGrid1.Col = 13: MSGrid1.Text = "工序名称"
   MSGrid1.Col = 14: MSGrid1.Text = "工时"
   MSGrid1.Col = 15: MSGrid1.Text = "备注"
   MSGrid1.Col = 16: MSGrid1.Text = "备注"
   MSGrid1.Col = 17: MSGrid1.Text = "备注"
End Sub

Private Sub cmddate1_Click()
    MonthView1.Visible = True
End Sub

  Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
    MonthView1.Visible = False
    Mskdate1.Text = MonthView1.Value
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 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

    With mobjexcel         '添加工作表
        .workbooks.Add
    End With

    With mobjexcel        '设置工作表字体,列宽
        .ActiveCell.Columns("A:A").ColumnWidth = 3
        .ActiveCell.Columns("B:B").ColumnWidth = 8
        .ActiveCell.Columns("C:C").ColumnWidth = 6
        .ActiveCell.Columns("D:D").ColumnWidth = 6
        .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 = 8
        .ActiveCell.Columns("K:K").ColumnWidth = 8
        .ActiveCell.Columns("L:L").ColumnWidth = 8
        .ActiveCell.Columns("M:M").ColumnWidth = 8
        .ActiveCell.Columns("N:N").ColumnWidth = 6
        .ActiveCell.Columns("O:O").ColumnWidth = 6
    End With

    'irowNo = 1                  'Excel row
    mobjexcel.Visible = True    'Excel visible
    
    With mobjexcel
        .ActiveCell.Cells(1, 1).Value = "绍兴金氏机械设备有限公司  工票流水帐"
        .ActiveCell.Cells(3, 1).Value = "日期:" & Mskdate1.Text & "--" & mskdate2.Text
    End With
    
    For irowNo = 0 To MSGrid1.Rows - 1
            For j = 0 To MSGrid1.Cols - 1
                MSGrid1.Row = irowNo
                MSGrid1.Col = j
                With mobjexcel
                    If j = 1 Or j = 6 Then
                        .ActiveCell.Cells(irowNo + 4, j + 1).Value = "A" & MSGrid1.Text
                    Else
                        .ActiveCell.Cells(irowNo + 4, j + 1).Value = MSGrid1.Text
                    End If
                End With
            Next j
    Next irowNo

     
    
    With mobjexcel        '设置工作表字体,列宽
        'sRange = Chr(Asc("A")) & "2" & ":" & Chr(Asc("AL")) & irowNo
        sRange = "(" & "A4:O" & (irowNo + 4) & ")"
        .Range(sRange).Select            '设置范围
        .Selection.RowHeight = 16        'Excel行高
        .Selection.Font.Name = "宋体"    'Excel 字体
        .Selection.Font.Size = 9         'Excel 字号
        .Selection.Borders.LineStyle = tvwRootLines   '画边框线
    End With
    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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -