frmcl.frm

适合于中小型企业管理

    Set CmdExe = New ADODB.Command
    CmdExe.CommandTimeout = 0
     CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
    If CmbBm2.ListIndex > -1 Then
        CmdExe.CommandText = "Sd_阶段产量C '" & CmbBm2.Text & "','" & DTPicker1.Value & "','" & DTPicker2.Value & "'"
        CmdExe.Execute
    Else
        MsgBox "请选择部门名称!"
        Exit Sub
    End If
    If OptCJygmx2.Value = 0 Then
        DataReport4.Sections(2).Controls("LableTitle").Caption = "宇迪 " & CStr(CmbBm1.Text) & " 阶段产量报表"
        DataReport4.Sections(2).Controls("LabelDate").Caption = "出表时间：" & CStr(GsdateT)
            DataReport4.Sections(2).Controls("Label3").Caption = "统计日期：" & DTPicker1.Value & "至" & DTPicker2.Value
        TxtSql = "SELECT 部门名称,Bs_产品图号.图号,Bs_产品图号.品名,Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 部门名称='" _
        & CmbBm2.Text & "' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' and 擦片人 is not null GROUP BY 部门名称,Bs_产品图号.图号,Bs_产品图号.品名,Bs_产品图号.规格,Bs_产品图号.硝材 order by Bs_产品图号.图号"
        Set Mrc = New ADODB.Recordset
            Mrc.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Set DataReport4.DataSource = Mrc
            DataReport4.Refresh
            DataReport4.Show 1
            Mrc.Close
    Else
            DataReport5.Sections(2).Controls("LableTitle").Caption = "宇迪" & CStr(CmbBm1.Text) & "－擦片 阶段产量报表"
            DataReport5.Sections(2).Controls("LabelDate").Caption = "出表时间：" & CStr(GsdateT)
            DataReport5.Sections(2).Controls("Label3").Caption = "统计日期：" & DTPicker1.Value & "至" & DTPicker2.Value
        TxtSql = "SELECT 部门名称, 擦片人,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级, SUM(站报废) as 站报废, SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 擦片人 is not null and 部门名称='" _
        & CmbBm2.Text & "' and 擦片人 like '%" & TxtRY.Text & "%' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' GROUP BY 部门名称,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, 擦片人 order by 擦片人, Bs_产品图号.图号"
         Set Mrc = New ADODB.Recordset
            Mrc.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Set DataReport5.DataSource = Mrc
            DataReport5.Refresh
            DataReport5.Show 1
            Mrc.Close
    End If
Else
    Set CmdExe = New ADODB.Command
    CmdExe.CommandTimeout = 0
     CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
    If CmbBm2.ListIndex > -1 Then
        CmdExe.CommandText = "Sd_阶段产量Z '" & CmbBm2.Text & "','" & DTPicker1.Value & "','" & DTPicker2.Value & "'"
        CmdExe.Execute
    Else
        MsgBox "请选择部门名称!"
        Exit Sub
    End If
    If OptCJygmx2.Value = 0 Then
        DataReport4.Sections(2).Controls("LableTitle").Caption = "宇迪 " & CStr(CmbBm1.Text) & " 阶段产量报表"
        DataReport4.Sections(2).Controls("LabelDate").Caption = "出表时间：" & CStr(GsdateT)
            DataReport4.Sections(2).Controls("Label3").Caption = "统计日期：" & DTPicker1.Value & "至" & DTPicker2.Value
        TxtSql = "SELECT 部门名称, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 部门名称='" _
        & CmbBm2.Text & "' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' and 站机人 is not null GROUP BY 部门名称,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材 order by Bs_产品图号.图号"
        Set Mrc = New ADODB.Recordset
            Mrc.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Set DataReport4.DataSource = Mrc
            DataReport4.Refresh
            DataReport4.Show 1
            Mrc.Close
    Else
            DataReport3.Sections(2).Controls("LableTitle").Caption = "宇迪 " & CStr(CmbBm1.Text) & "－站机 阶段产量报表"
            DataReport3.Sections(2).Controls("LabelDate").Caption = "出表时间：" & CStr(GsdateT)
            DataReport3.Sections(2).Controls("Label3").Caption = "统计日期：" & DTPicker1.Value & "至" & DTPicker2.Value
        TxtSql = "SELECT 部门名称, 站机人, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材,  SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 站机人 is not null and 部门名称='" _
        & CmbBm2.Text & "' and 站机人 like '%" & TxtRY.Text & "%' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' GROUP BY 部门名称, 站机人, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材 order by 站机人, Bs_产品图号.图号"
       Set Mrc = New ADODB.Recordset
            Mrc.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
            Set DataReport3.DataSource = Mrc
            DataReport3.Refresh
            DataReport3.Show 1
            Mrc.Close
    End If

End If
End Sub

Private Sub Command6_Click()
    Dim CmdExe As ADODB.Command

If OptGx2.Value = 0 Then
    Set CmdExe = New ADODB.Command
    CmdExe.CommandTimeout = 0
     CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
    If CmbBm2.ListIndex > -1 Then
        CmdExe.CommandText = "Sd_阶段产量C '" & CmbBm2.Text & "','" & DTPicker1.Value & "','" & DTPicker2.Value & "'"
        CmdExe.Execute
    Else
        MsgBox "请选择部门名称!"
        Exit Sub
    End If
    If OptCJygmx2.Value = 0 Then '车间报表（默认镀膜）
        TxtSql = "SELECT 部门名称,Bs_产品图号.图号,Bs_产品图号.品名,Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 部门名称='" _
        & CmbBm2.Text & "' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' and 擦片人 is not null GROUP BY 部门名称,Bs_产品图号.图号,Bs_产品图号.品名,Bs_产品图号.规格,Bs_产品图号.硝材 order by Bs_产品图号.图号"
        Set Rstmp = New ADODB.Recordset
        Rstmp.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Set DataGrid2.DataSource = Rstmp

    Else                     '车间员工明细报表（默认镀膜）
        TxtSql = "SELECT 部门名称, 擦片人,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级, SUM(站报废) as 站报废, SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 擦片人 is not null and 部门名称='" _
        & CmbBm2.Text & "' and 擦片人 like '%" & TxtRY.Text & "%' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' GROUP BY 部门名称,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, 擦片人 order by 擦片人, Bs_产品图号.图号"
        Set Rstmp = New ADODB.Recordset
        Rstmp.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Set DataGrid2.DataSource = Rstmp

    End If
Else
    Set CmdExe = New ADODB.Command
    CmdExe.CommandTimeout = 0
     CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
    If CmbBm2.ListIndex > -1 Then
        CmdExe.CommandText = "Sd_阶段产量Z '" & CmbBm2.Text & "','" & DTPicker1.Value & "','" & DTPicker2.Value & "'"
        CmdExe.Execute
    Else
        MsgBox "请选择部门名称!"
        Exit Sub
    End If
    If OptCJygmx2.Value = 0 Then  '车间报表（站机）
        TxtSql = "SELECT 部门名称, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材, SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 部门名称='" _
        & CmbBm2.Text & "' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' and 站机人 is not null GROUP BY 部门名称,Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材 order by Bs_产品图号.图号"
        Set Rstmp = New ADODB.Recordset
        Rstmp.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Set DataGrid2.DataSource = Rstmp
      
    Else                        '车间员工明细报表（站机）
        TxtSql = "SELECT 部门名称, 站机人, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材,  SUM(领一级) as 领一级, SUM(领二级) as 领二级,SUM(送检数) as 送检数, SUM(一级品) as 一级品, (sum(一级品)+sum(留用数))/sum(送检数)*100 as 正品率,SUM(留用数) as 留用数, SUM(站二级) as 站二级,SUM(站报废) as 站报废,  SUM(擦二级) as 擦二级,Sum (擦报废) as 擦报废, Sum(返工数) as 返工数 From dbo.Dm_产量表,Bs_产品图号 where dm_产量表.图号=Bs_产品图号.图号 and 站机人 is not null and 部门名称='" _
        & CmbBm2.Text & "' and 站机人 like '%" & TxtRY.Text & "%' and Bs_产品图号.品名 like '%" & TxtPm.Text & "%' GROUP BY 部门名称, 站机人, Bs_产品图号.图号, Bs_产品图号.品名, Bs_产品图号.规格,Bs_产品图号.硝材 order by 站机人, Bs_产品图号.图号"
        Set Rstmp = New ADODB.Recordset
        Rstmp.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Set DataGrid2.DataSource = Rstmp


    End If
End If
End Sub

Private Sub Command7_Click()
    Cdlg.DialogTitle = "另存为Excel文件："
    Cdlg.Filter = "Excel文件|*.Xls|所有文件|*.*"
    Cdlg.ShowSave
    If Cdlg.FileName = "" Then Exit Sub
         OutTxt2.Text = Cdlg.FileName
End Sub

Private Sub Command8_Click()
On Error GoTo errs
    Dim Rs As ADODB.Recordset
    Dim ExcelApp As Excel.Application
    Dim ExcelBook As Excel.Workbook
    Dim ExcelSheet As Excel.Worksheet

    Set ExcelApp = New Excel.Application
    ExcelApp.Visible = False
    Set ExcelBook = ExcelApp.Workbooks.Add
    Set ExcelSheet = ExcelBook.Worksheets.Item(1)
    
    Set Rs = New ADODB.Recordset
     
    Rs.Open TxtSql, Cw_DataEnvi.DataConnect, , adLockPessimistic, adCmdText
    RecordsetToExcel Rs, ExcelSheet
    If OutTxt2.Text = "" Then
      MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
      Exit Sub
    End If
    On Error GoTo ErrSave
     ExcelBook.Close True, OutTxt2.Text
     MsgBox "输出成功！文件位于" & OutTxt2.Text
     Rs.Close

Exit Sub
errs:
    MsgBox "Select 语句错误！", 16, "严重错误"
    ExcelBook.Close False
     Exit Sub
ErrSave:
    MsgBox "输出错误！", 16, "严重错误"
End Sub

Private Sub Command9_Click()
On Error GoTo errs
    Dim Rs As ADODB.Recordset
    Dim ExcelApp As Excel.Application
    Dim ExcelBook As Excel.Workbook
    Dim ExcelSheet As Excel.Worksheet

    Set ExcelApp = New Excel.Application
    ExcelApp.Visible = False
    Set ExcelBook = ExcelApp.Workbooks.Add
    Set ExcelSheet = ExcelBook.Worksheets.Item(1)
    
    Set Rs = New ADODB.Recordset
     
    Rs.Open TxtSql, Cw_DataEnvi.DataConnect, , adLockPessimistic, adCmdText
    RecordsetToExcel Rs, ExcelSheet
    If OutTxt3.Text = "" Then
      MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
      Exit Sub
    End If
    On Error GoTo ErrSave
     ExcelBook.Close True, OutTxt3.Text
     MsgBox "输出成功！文件位于" & OutTxt3.Text
     Rs.Close

Exit Sub
errs:
    MsgBox "Select 语句错误！", 16, "严重错误"
    ExcelBook.Close False
     Exit Sub
ErrSave:
    MsgBox "输出错误！", 16, "严重错误"
End Sub

Private Sub Form_Load()
    Me.Caption = "产量报表 (" & Me.Caption & ")"
    SSTab1.Tab = 0
    DTPicker0.Value = Date
    DTPicker1.Value = Date
    DTPicker2.Value = Date
    DTPicker3.Value = Date
    DTPicker4.Value = Date
    
    Dim Rs As ADODB.Recordset
    Set Rs = New ADODB.Recordset
    Rs.Open "select 部门名称 from Bs_部门分类  where 生产部门=1 order by 部门名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    
    CmbBm1.Clear
    CmbBm2.Clear
    Do While Not Rs.EOF
        CmbBm1.AddItem Rs!部门名称
        CmbBm2.AddItem Rs!部门名称
        Rs.MoveNext
    Loop
        If Rs.State <> adStateClosed Then Rs.Close

End Sub

'纪录导出到Execl
Public Sub RecordsetToExcel(Rs As ADODB.Recordset, excel_sheet As Excel.Worksheet)
    Dim i As Long, j As Long
    Dim excel_range As Excel.Range
    Dim col_count As Long

    If Rs.RecordCount = 0 Then
        Exit Sub
    End If

    Set excel_range = excel_sheet.Cells
    col_count = Rs.Fields.Count
                
    For i = 0 To col_count - 1
        excel_sheet.Cells(1, i + 1).Value = Rs.Fields(i).Name
    Next
    excel_sheet.Range(excel_sheet.Cells(1, 1), _
                      excel_sheet.Cells(1, col_count)).Font.Bold = True
        
    excel_sheet.Range("A2").CopyFromRecordset Rs
            
End Sub