gplxfind.frm

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

      Caption         =   "零星工票　检索"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   315
      Index           =   0
      Left            =   3840
      TabIndex        =   17
      Top             =   180
      Width           =   2355
   End
End
Attribute VB_Name = "gplxfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim griditem1 As String
Dim Totgs As Currency

Private Sub Form_Load()
    Me.Width = 10400
    Me.Height = 8260
    
    Grid1.Cols = 16
    Grid1.FixedCols = 4
    Grid1.Column(0).Width = 1
    Grid1.Column(1).Width = 30
    Grid1.Column(2).Width = 90
    Grid1.Column(3).Width = 80
    Grid1.Column(4).Width = 80
    Grid1.Column(5).Width = 80
    Grid1.Column(6).Width = 70
    Grid1.Column(7).Width = 90
    Grid1.Column(8).Width = 90
    Grid1.Column(9).Width = 80
    Grid1.Column(10).Width = 60
    Grid1.Column(11).Width = 60
    Grid1.Column(12).Width = 50
    Grid1.Column(13).Width = 60
    Grid1.Column(14).Width = 60
    Grid1.Column(15).Width = 60
    
    dofillgrid
     
    Set rsTempA = oDb.Execute("select * from acj")
    Do Until rsTempA.EOF
        cmbcj.AddItem rsTempA!cjmc
        rsTempA.MoveNext
    Loop
    
     Set rsTempA = oDb.Execute("select * from acplx")
    Do Until rsTempA.EOF
        cmbcp.AddItem rsTempA!cpmc
        rsTempA.MoveNext
    Loop
    
    Mskdate1.Text = NOWDate
    MonthView1.Visible = False
    MonthView1.Value = NOWDate
    mskdate2.Text = NOWDate
    MonthView2.Visible = False
    MonthView2.Value = NOWDate
    
    txtcp.Visible = False
    txtbj.Visible = False
End Sub
Private Sub cmdfind_Click()
    Totgs = 0
    griditem = "select * from gplxh 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 & "'"
     
    If cmbcp.Text <> "" Then griditem = griditem & " and gpcpbh = '" & txtcp.Text & "'"
    If cmbbj.Text <> "" Then griditem = griditem & " and gpbjbh ='" & txtbj.Text & "'"
    
    Set rsTempA = oDb.Execute(griditem)
    i = 1
    Grid1.Rows = 1
    Do Until rsTempA.EOF
        griditem = rsTempA!gpbh & Chr(9) & rsTempA!gphm & Chr(9) & rsTempA!gpcjmc & Chr(9) & rsTempA!gpbzmc
        Set rsTempC = oDb.Execute("select * from acplx where cpbh='" & rsTempA!gpcpbh & "'")
        griditem = griditem & Chr(9) & rsTempC!cpmc
        Set rsTempC = oDb.Execute("select * from abjlx where bjbh='" & rsTempA!gpbjbh & "'")
        If rsTempC.RecordCount > 0 Then                                                '20071113加入
            griditem = griditem & Chr(9) & rsTempC!bjmc
        Else
            griditem = griditem & Chr(9) & ""
        End If
        Set rsTempB = oDb.Execute("select * from gplxb where gpbh='" & rsTempA!gpbh & "'")
        Do Until rsTempB.EOF
            griditem1 = 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
            Grid1.AddItem i & Chr(9) & griditem & Chr(9) & griditem1
            Totgs = Totgs + rsTempB!gpgs
            i = i + 1
            rsTempB.MoveNext
        Loop
        rsTempA.MoveNext
    Loop
    Grid1.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 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 cmbcp_LostFocus()
    If cmbcp.Text = "" Then Exit Sub
    Set rsTempA = oDb.Execute("select * from acplx where cpmc='" & cmbcp.Text & "'")
    If Not IsNull(rsTempA!cpbh) Then txtcp.Text = rsTempA!cpbh
    
    cmbbj.Clear
    Set rsTempA = oDb.Execute("select * from abjlx where cpmc='" & cmbcp.Text & "'")
    Do Until rsTempA.EOF
        cmbbj.AddItem rsTempA!bjmc
        rsTempA.MoveNext
    Loop
End Sub
Private Sub cmbbj_LostFocus()
    Set rsTempA = oDb.Execute("select * from abjlx where cpmc='" & cmbcp.Text & "' and bjmc='" & cmbbj.Text & "'")
    If Not IsNull(rsTempA!bjbh) Then txtbj.Text = rsTempA!bjbh
End Sub

Private Sub dofillgrid()
   Grid1.Rows = 1
   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 = "工序名称"
   Grid1.Cell(0, 12).Text = "工时"
   Grid1.Cell(0, 13).Text = "备注"
   Grid1.Cell(0, 14).Text = "备注"
   Grid1.Cell(0, 15).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 = 6
        .ActiveCell.Columns("K:K").ColumnWidth = 8
        .ActiveCell.Columns("L:L").ColumnWidth = 8
        .ActiveCell.Columns("M:M").ColumnWidth = 8
        .ActiveCell.Columns("N:N").ColumnWidth = 8
        .ActiveCell.Columns("O:O").ColumnWidth = 8
        .ActiveCell.Columns("P:P").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 = 0 To Grid1.Cols - 1
                With mobjexcel
                        .ActiveCell.Cells(irowNo + 4, j + 1).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:P" & (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