tjymgstot.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Object = "{4F29B06F-16D9-4A0C-9C8A-2F0C02F625FE}#1.0#0"; "FlexCell.ocx"
Begin VB.Form tjymgstot 
   Caption         =   "产品总工时"
   ClientHeight    =   7980
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11865
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   7980
   ScaleWidth      =   11865
   Begin MSComCtl2.MonthView MonthView2 
      Height          =   2370
      Left            =   4020
      TabIndex        =   12
      Top             =   990
      Width           =   4065
      _ExtentX        =   7170
      _ExtentY        =   4180
      _Version        =   393216
      ForeColor       =   -2147483630
      BackColor       =   -2147483633
      Appearance      =   1
      StartOfWeek     =   65077249
      CurrentDate     =   39000
   End
   Begin MSComCtl2.MonthView MonthView1 
      Height          =   2370
      Left            =   2310
      TabIndex        =   11
      Top             =   1110
      Width           =   4065
      _ExtentX        =   7170
      _ExtentY        =   4180
      _Version        =   393216
      ForeColor       =   -2147483630
      BackColor       =   -2147483633
      Appearance      =   1
      StartOfWeek     =   65077249
      CurrentDate     =   39000
   End
   Begin FlexCell.Grid Grid1 
      Height          =   6735
      Left            =   60
      TabIndex        =   10
      Top             =   1170
      Width           =   11745
      _ExtentX        =   20717
      _ExtentY        =   11880
      Cols            =   5
      Rows            =   30
   End
   Begin VB.CommandButton cmdexcel 
      Caption         =   "Excel导出"
      Height          =   315
      Left            =   9000
      TabIndex        =   1
      Top             =   780
      Width           =   1275
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   315
      Left            =   10620
      TabIndex        =   9
      Top             =   780
      Width           =   1035
   End
   Begin VB.CommandButton cmddate2 
      Caption         =   "Command1"
      Height          =   195
      Left            =   3840
      TabIndex        =   3
      Top             =   870
      Width           =   195
   End
   Begin VB.CommandButton cmddate1 
      Caption         =   "Command2"
      Height          =   195
      Left            =   2220
      TabIndex        =   2
      Top             =   870
      Width           =   195
   End
   Begin VB.CommandButton cmdfind 
      Caption         =   "检索"
      Height          =   315
      Left            =   7560
      TabIndex        =   0
      Top             =   780
      Width           =   1095
   End
   Begin MSMask.MaskEdBox Mskdate1 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "yyyy-MM-dd"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   3
      EndProperty
      Height          =   315
      Left            =   1020
      TabIndex        =   4
      Top             =   810
      Width           =   1155
      _ExtentX        =   2037
      _ExtentY        =   556
      _Version        =   393216
      PromptChar      =   "_"
   End
   Begin MSMask.MaskEdBox mskdate2 
      Height          =   315
      Left            =   2700
      TabIndex        =   5
      Top             =   810
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   556
      _Version        =   393216
      PromptChar      =   "_"
   End
   Begin VB.Label Label1 
      Caption         =   "----"
      Height          =   195
      Index           =   5
      Left            =   2460
      TabIndex        =   8
      Top             =   870
      Width           =   255
   End
   Begin VB.Label Label1 
      Caption         =   "工票日期"
      Height          =   195
      Index           =   8
      Left            =   120
      TabIndex        =   7
      Top             =   870
      Width           =   795
   End
   Begin VB.Label Label2 
      Caption         =   "工时完成情况表"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   435
      Index           =   0
      Left            =   4380
      TabIndex        =   6
      Top             =   60
      Width           =   2955
   End
End
Attribute VB_Name = "tjymgstot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'本表行为个人，列为个人＋定额/增拨工序分数＋小计＋小时
Option Explicit
Dim Gsdn As Currency, gszp As Currency, gstot As Currency
Dim bzname As String, gsdate1 As String, gsdate2 As String
Private Sub Form_Load()
    Me.Width = 12000
    Me.Height = 8500
    
    Grid1.AutoRedraw = False
    Grid1.DisplayFocusRect = False
    Grid1.Cols = 13
    Grid1.FixedRows = 2
    Grid1.Rows = 2
    
    Grid1.Column(0).Width = 2
    Grid1.Column(1).Width = 30
    Grid1.Column(2).Width = 60
    Grid1.Column(3).Width = 110
    Grid1.Column(4).Width = 110
    For i = 5 To 12
        Grid1.Column(i).Width = 60
    Next i
    
    dogridfill
    Grid1.AutoRedraw = True
    Grid1.Refresh
    
    Mskdate1.Text = NOWDate - 10
    MonthView1.Visible = False
    MonthView1.Value = NOWDate
    mskdate2.Text = NOWDate
    MonthView2.Visible = False
    MonthView2.Value = NOWDate
End Sub
Private Sub cmdfind_Click()
    Grid1.Rows = 2
    
    frmwait.Show 0
    DoEvents
    
    Set rsTempA = oDb.Execute("select * from acp where cpyn='Y' order by cpbh")
    Do Until rsTempA.EOF
        Gsdn = 0
        gszp = 0
        griditem = (Grid1.Rows - 1) & Chr(9) & rsTempA!dhmc & Chr(9) & rsTempA!cpmc & Chr(9) & rsTempA!cpxh
        
        '按产品、日期区间统计定额工时
        szSql = "select sum(gpdnb.gpgs) as sumgs from gpdnh,gpdnb where (gpdnh.gpbh=gpdnb.gpbh) and gpdnh.gprq>='" & Mskdate1.Text & "' and gpdnh.gprq<='" & mskdate2.Text & "'" _
                & " and gpdnh.gpcpbh='" & rsTempA!cpbh & "'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            Gsdn = Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
        
        '增拨工时 设计更改
         szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & Mskdate1.Text & "' and gpzph.gprq<='" & mskdate2.Text & "'" _
                & " and gpzph.gpcpbh='" & rsTempA!cpbh & "' and gpzph.gpgslb='设计更改'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            gszp = Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
        '工艺更改
         szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & Mskdate1.Text & "' and gpzph.gprq<='" & mskdate2.Text & "'" _
                & " and gpzph.gpcpbh='" & rsTempA!cpbh & "' and gpzph.gpgslb='工艺更改'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            gszp = gszp + Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
      
        '计划更改
         szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & Mskdate1.Text & "' and gpzph.gprq<='" & mskdate2.Text & "'" _
                & " and gpzph.gpcpbh='" & rsTempA!cpbh & "' and gpzph.gpgslb='计划更改'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            gszp = gszp + Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
         '质量损失
         szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & Mskdate1.Text & "' and gpzph.gprq<='" & mskdate2.Text & "'" _
                & " and gpzph.gpcpbh='" & rsTempA!cpbh & "' and gpzph.gpgslb='质量损失'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            gszp = gszp + Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
        '设备返修
         szSql = "select sum(gpzpb.gpgs) as sumgs from gpzph,gpzpb where (gpzph.gpbh=gpzpb.gpbh) and gpzph.gprq>='" & Mskdate1.Text & "' and gpzph.gprq<='" & mskdate2.Text & "'" _
                & " and gpzph.gpcpbh='" & rsTempA!cpbh & "' and gpzph.gpgslb='设备返修'"
        Set rsTempB = oDb.Execute(szSql)
        If rsTempB!sumgs > 0 Then
            griditem = griditem & Chr(9) & Round(rsTempB!sumgs / 60, 1)
            gszp = gszp + Round(rsTempB!sumgs / 60, 1)
        Else
            griditem = griditem & Chr(9) & ""
        End If
      
        Grid1.AddItem griditem & Chr(9) & gszp & Chr(9) & (Gsdn + gszp)
        rsTempA.MoveNext
    Loop
    
    griditem = "" & Chr(9) & "合计" & Chr(9) & "" & Chr(9) & ""
    For j = 5 To 12
        gstot = 0
        For i = 2 To Grid1.Rows - 1
            gstot = gstot + Val(Grid1.Cell(i, j).Text)
        Next i
        griditem = griditem & Chr(9) & gstot
    Next j
    Grid1.AddItem griditem
    Unload frmwait
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, 0, 11).Merge
    Grid1.Range(0, 12, 1, 12).Merge
    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(1, 6).Text = "设计更改"
    Grid1.Cell(1, 7).Text = "工艺更改"
    Grid1.Cell(1, 8).Text = "计划更改"
    Grid1.Cell(1, 9).Text = "质量损失"
    Grid1.Cell(1, 10).Text = "设备返修"
    Grid1.Cell(1, 11).Text = "小计"
    Grid1.Cell(0, 12).Text = "合计"
    For i = 5 To 12
        Grid1.Column(i).Alignment = cellRightCenter
    Next i
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 = 10
        .ActiveCell.Columns("C:C").ColumnWidth = 10
        .ActiveCell.Columns("D:D").ColumnWidth = 10
        .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
    End With

    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 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:X" & (irowNo + 3) & ")"
        .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