结算方案参数.frm

适合于中小型企业管理

         ItmX.SubItems(7) = Jlbrec!二级品价
         ItmX.SubItems(8) = Jlbrec!料质价
         ItmX.SubItems(9) = Jlbrec!原材料价
         ItmX.SubItems(10) = Jlbrec!成品率
         ItmX.SubItems(11) = Jlbrec!一废品率
         ItmX.SubItems(12) = Jlbrec!二废品率
        
        Jlbrec.MoveNext
    Loop

    '以上为自定义部分<<]
  
    '将网格刷新动作解冻
     lstContracts.Refresh
End Sub

Private Sub Command7_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 "select * from Gz_基础数据 order by 工序名称,图号", Cw_DataEnvi.DataConnect, , adLockReadOnly, adCmdText
        RecordsetToExcel Rs, ExcelSheet
        If OutTxt.Text = "" Then
          MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
          Exit Sub
        End If
        On Error GoTo ErrSave
         ExcelBook.Close True, OutTxt.Text
         MsgBox "输出成功！文件位于" & OutTxt.Text
         Rs.Close
    
    Exit Sub
errs:
        MsgBox "Select 语句错误！", 16, "严重错误"
        ExcelBook.Close False
         Exit Sub
ErrSave:
        MsgBox "输出错误！", 16, "严重错误"
End Sub

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

Private Sub Form_Load()
    '调入网格设置信息
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , " ID", 500
    lstContracts.ColumnHeaders.Add , , "工序", 600
    lstContracts.ColumnHeaders.Add , , " 图号", 1000
    lstContracts.ColumnHeaders.Add , , " 品名", 1000
    lstContracts.ColumnHeaders.Add , , " 规格", 1000
    lstContracts.ColumnHeaders.Add , , " 硝材", 800
    lstContracts.ColumnHeaders.Add , , "一级品价", 900
    lstContracts.ColumnHeaders.Add , , "二级品价", 900
    lstContracts.ColumnHeaders.Add , , "料质价", 750
    lstContracts.ColumnHeaders.Add , , "原材料", 750
    lstContracts.ColumnHeaders.Add , , "成品率", 750
    lstContracts.ColumnHeaders.Add , , "一废品率", 900
    lstContracts.ColumnHeaders.Add , , "二废品率", 900
    
    
    Set CmdExe = New ADODB.Command
    CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
    
 '添加品名列表
    Dim topNode As Node
    Dim RsPm As ADODB.Recordset
    Set RsPm = New ADODB.Recordset
    RsPm.Open "select 图号,品名,规格 from Bs_产品图号 order by 图号", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    CmbTH.Clear
    CmbPM.Clear
    TV.Nodes.Clear
    Do While Not RsPm.EOF
        CmbTH.AddItem RsPm!图号
        CmbPM.AddItem RsPm!品名
        RsPm.MoveNext
    Loop
    RsPm.Close

    '添加工序列表
    Dim RsPZ As ADODB.Recordset
    Set RsPZ = New ADODB.Recordset
    RsPZ.Open "select 工序名称 from Bs_生产流程 order by 工序名称", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    Do While Not RsPZ.EOF
        Set topNode = TV.Nodes.Add(, , "A" & CStr(RsPZ!工序名称), RsPZ!工序名称, "Root")
        CmbGx.AddItem RsPZ!工序名称
        topNode.Tag = RsPZ!工序名称
        LoadChild (RsPZ!工序名称)
        
        RsPZ.MoveNext
    Loop
    RsPZ.Close

End Sub

Private Sub LoadChild(Lbj As String)
        Dim child As Node

        Set RsGg = New ADODB.Recordset
    
        RsGg.Open "select * from Gz_基础数据 where 工序名称 = '" & Lbj & "' ", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Do While Not RsGg.EOF
            Set child = TV.Nodes.Add("A" & Lbj, tvwChild, "B" & Lbj & CStr(RsGg!图号), RsGg!图号, "Child")
                child.Tag = RsGg!图号
            RsGg.MoveNext
        Loop
End Sub

Private Sub Toolbjzt()                                   'Toolbar状态(编辑状态)
        Text1.Enabled = True
        Text2.Enabled = True
        Text3.Enabled = True
        Text4.Enabled = True
        Text5.Enabled = True
        Text6.Enabled = True
        Text7.Enabled = True
        
        CmbGx.Enabled = True
        CmbTH.Enabled = True
        CmbPM.Enabled = True
        
        TV.Enabled = False
        lstContracts.Enabled = False
        
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = True
        Command5.Enabled = True
        
End Sub

Private Sub ToolList()                                    '列表刷新
    
    '添加工序列表
    TV.Nodes.Clear
    Set RsPZ = New ADODB.Recordset
    RsPZ.Open "select 工序名称 from Bs_生产流程 order by 工序名称", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    Do While Not RsPZ.EOF
        Set topNode = TV.Nodes.Add(, , "A" & CStr(RsPZ!工序名称), RsPZ!工序名称, "Root")
        topNode.Tag = RsPZ!工序名称
        LoadChild (RsPZ!工序名称)
        
        RsPZ.MoveNext
    Loop
    RsPZ.Close
    lstContracts.ListItems.Clear
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
        Text1.Enabled = False
        Text2.Enabled = False
        Text3.Enabled = False
        Text4.Enabled = False
        Text5.Enabled = False
        Text6.Enabled = False
        Text7.Enabled = False

        CmbGx.Enabled = False
        CmbTH.Enabled = False
        CmbPM.Enabled = False
        
        TV.Enabled = True
        lstContracts.Enabled = True
        
        Command1.Enabled = True
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = False
        Command5.Enabled = False
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

'修改、删除权限管理
Private Function RsQx() As Boolean
        Set RsJcqx = New ADODB.Recordset
        RsJcqx.Open "select 创建者 from Gz_基础数据 where (ID=" & Lablsh.Caption & ")", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
        If RsJcqx!创建者 <> Xtczy Then
            RsQx = False
           MsgBox "创建者：" & RsJcqx!创建者 & "。", vbExclamation, "请联系管理员！"
           Exit Function
        Else
            RsQx = True
        End If
End Function

Private Sub lstContracts_ItemClick(ByVal Item As MSComctlLib.ListItem)
    '[>>查询连接串
    Sqlstr = "SELECT Gz_基础数据.id,工序名称,Gz_基础数据.图号,品名,规格,硝材,一级品价,二级品价,料质价,原材料价,成品率,一废品率,二废品率 FROM Gz_基础数据,BS_产品图号 where Gz_基础数据.图号=BS_产品图号.图号 and Gz_基础数据.ID=" & lstContracts.SelectedItem.Text
    '<<]
    Set RsGg = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    With RsGg
        If Trim(lstContracts.SelectedItem.Text) <> "" Then

            CmbGx.Text = !工序名称
            CmbTH.Text = !图号
            CmbPM.Text = !品名
            TxtGG.Text = !规格
            TxtXc.Text = !硝材
            Text1.Text = !一级品价
            Text2.Text = !二级品价
            Text3.Text = !料质价
            Text4.Text = !原材料价
            Text5.Text = !成品率
            Text6.Text = !一废品率
            Text7.Text = !二废品率

            Lablsh.Caption = !Id
            
            Command2.Enabled = True
            Command3.Enabled = True
        End If
    End With
End Sub

Private Sub tv_NodeClick(ByVal Node As MSComctlLib.Node)
   On Error Resume Next
   Dim txtSQLBJ As String
    If Left(Node.Key, 1) = "B" Then
        CBJ = Right(Node.Parent.Key, Len(Node.Parent.Key) - 1)
        CmbGx.Text = Node.Parent.Tag
        CJMC = Node.Parent.Tag
        YGXM = Node.Tag
        '[>>查询连接串
        Sqlstr = "SELECT Gz_基础数据.id,工序名称,Gz_基础数据.图号,品名,规格,硝材,一级品价,二级品价,料质价,原材料价,成品率,一废品率,二废品率 FROM Gz_基础数据,BS_产品图号 where Gz_基础数据.图号=BS_产品图号.图号 and Gz_基础数据.图号='" & YGXM & "' and 工序名称='" & CJMC & "'"
        '<<]
        Set RsGg = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
        With RsGg
            If Trim(lstContracts.SelectedItem.Text) <> "" Then
                CmbGx.Text = !工序名称
                CmbTH.Text = !图号
                CmbPM.Text = !品名
                TxtGG.Text = !规格
                TxtXc.Text = !硝材
                Text1.Text = !一级品价
                Text2.Text = !二级品价
                Text3.Text = !料质价
                Text4.Text = !原材料价
                Text5.Text = !成品率
                Text6.Text = !一废品率
                Text7.Text = !二废品率
    
                Lablsh.Caption = !Id
                
                Command2.Enabled = True
                Command3.Enabled = True
            End If
        End With
    ElseIf Left(Node.Key, 1) = "A" Then
        CBJ = Right(Node.Key, Len(Node.Key) - 1)
        CmbGx.Text = Node.Tag
        CJMC = Node.Tag
        CmbTH.Text = ""
        CmbPM.Text = ""
        TxtGG.Text = ""
        TxtXc.Text = ""
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = ""
        Text6.Text = ""
        Text7.Text = ""
        Lablsh.Caption = ""
         Call Cxnrtcwg(CJMC)
         Call Toolfbjzt
    End If

End Sub

Private Sub Cxnrtcwg(StrBM As String)                                 '查询内容填充网格(刷新)
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结


    '[>>查询连接串
    Sqlstr = "SELECT Gz_基础数据.id,工序名称,Gz_基础数据.图号,品名,规格,硝材,一级品价,二级品价,料质价,原材料价,成品率,一废品率,二废品率 FROM Gz_基础数据,BS_产品图号 where Gz_基础数据.图号=BS_产品图号.图号 and 工序名称='" & StrBM & "' order by Gz_基础数据.图号"
    '<<]
    Set Jlbrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    

    '[>>以下为自定义部分
    Dim ItmX As ListItem

    lstContracts.ListItems.Clear
    Do While Not Jlbrec.EOF
        Set ItmX = lstContracts.ListItems.Add(, , Jlbrec!Id)
         ItmX.SubItems(1) = Jlbrec!工序名称
         ItmX.SubItems(2) = Jlbrec!图号
         ItmX.SubItems(3) = Jlbrec!品名
         ItmX.SubItems(4) = Jlbrec!规格
         ItmX.SubItems(5) = Jlbrec!硝材
         ItmX.SubItems(6) = Jlbrec!一级品价
         ItmX.SubItems(7) = Jlbrec!二级品价
         ItmX.SubItems(8) = Jlbrec!料质价
         ItmX.SubItems(9) = Jlbrec!原材料价
         ItmX.SubItems(10) = Jlbrec!成品率
         ItmX.SubItems(11) = Jlbrec!一废品率
         ItmX.SubItems(12) = Jlbrec!二废品率
        
        Jlbrec.MoveNext
    Loop

    '以上为自定义部分<<]
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub