frm_new_specbill.frm

一个公司的客户财产管理系统vb源码

      _StyleDefs(63)  =   "Named:id=41:RecordSelector"
      _StyleDefs(64)  =   ":id=41,.parent=34"
      _StyleDefs(65)  =   "Named:id=42:FilterBar"
      _StyleDefs(66)  =   ":id=42,.parent=33"
   End
End
Attribute VB_Name = "Frm_New_SpecBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub TDBGrid_Width_Set()
On Error GoTo err
  Dim i As Integer
  For i = 0 To 47
    Me.TDBGrid_CusRiches.Splits(0).Columns(i).DividerStyle = dbgCustomColor
    Me.TDBGrid_CusRiches.Splits(0).Columns(i).DividerColor = RGB(148, 190, 231)
  Next
  Me.TDBGrid_CusRiches.RowDividerStyle = dbgCustomColor
  Me.TDBGrid_CusRiches.RowDividerColor = RGB(148, 190, 231)
  Me.TDBGrid_CusRiches.Columns(0).Width = 600
  Me.TDBGrid_CusRiches.Columns(1).Width = 600
  Me.TDBGrid_CusRiches.Columns(2).Width = 600
  Me.TDBGrid_CusRiches.Columns(3).Width = 600
  Me.TDBGrid_CusRiches.Columns(4).Width = 600
  Me.TDBGrid_CusRiches.Columns(5).Width = 600
  Me.TDBGrid_CusRiches.Columns(6).Width = 600
  Me.TDBGrid_CusRiches.Columns(7).Width = 600
  Me.TDBGrid_CusRiches.Columns(8).Width = 600
  Me.TDBGrid_CusRiches.Columns(9).Width = 600
  Me.TDBGrid_CusRiches.Columns(10).Width = 600
  Me.TDBGrid_CusRiches.Columns(11).Width = 2500
  Me.TDBGrid_CusRiches.Columns(12).Width = 1000
  Me.TDBGrid_CusRiches.Columns(13).Width = 1000
  Me.TDBGrid_CusRiches.Columns(14).Width = 600
  Me.TDBGrid_CusRiches.Columns(15).Width = 600
  Me.TDBGrid_CusRiches.Columns(16).Width = 600
  Me.TDBGrid_CusRiches.Columns(17).Width = 600
  Me.TDBGrid_CusRiches.Columns(18).Width = 800
  Me.TDBGrid_CusRiches.Columns(19).Width = 800
  Me.TDBGrid_CusRiches.Columns(20).Width = 800
  Me.TDBGrid_CusRiches.Columns(21).Width = 800
  Me.TDBGrid_CusRiches.Columns(22).Width = 800
  Me.TDBGrid_CusRiches.Columns(23).Width = 600
  Me.TDBGrid_CusRiches.Columns(24).Width = 800
  Me.TDBGrid_CusRiches.Columns(25).Width = 800
  Me.TDBGrid_CusRiches.Columns(26).Width = 600
  Me.TDBGrid_CusRiches.Columns(27).Width = 800
  Me.TDBGrid_CusRiches.Columns(28).Width = 800
  Me.TDBGrid_CusRiches.Columns(29).Width = 1000
  Me.TDBGrid_CusRiches.Columns(30).Width = 1000
  Me.TDBGrid_CusRiches.Columns(31).Width = 1000
  Me.TDBGrid_CusRiches.Columns(32).Width = 600
  Me.TDBGrid_CusRiches.Columns(33).Width = 1000
  Me.TDBGrid_CusRiches.Columns(34).Width = 1000
  Me.TDBGrid_CusRiches.Columns(35).Width = 600
  Me.TDBGrid_CusRiches.Columns(36).Width = 600
  Me.TDBGrid_CusRiches.Columns(37).Width = 600
  Me.TDBGrid_CusRiches.Columns(38).Width = 600
  Me.TDBGrid_CusRiches.Columns(39).Width = 1200
  Me.TDBGrid_CusRiches.Columns(40).Width = 1500
  Me.TDBGrid_CusRiches.Columns(41).Width = 900
  Me.TDBGrid_CusRiches.Columns(42).Width = 2500
  Me.TDBGrid_CusRiches.Columns(43).Width = 2500
  Me.TDBGrid_CusRiches.Columns(44).Width = 800
  Me.TDBGrid_CusRiches.Columns(45).Width = 800
  Me.TDBGrid_CusRiches.Columns(46).Width = 600
  Me.TDBGrid_CusRiches.Columns(47).Width = 800
'  Me.TDBGrid_CusRiches.Columns(48).Width = 1000
  Me.TDBGrid_CusRiches.Columns(18).NumberFormat = "#,###,###"
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Activate()
    Call TDBGrid_Width_Set
End Sub

Private Sub Form_Load()
On Error GoTo err
      '将客户财产临时表清空
      Set Cn = New ADODB.Connection
      Set Rs = New ADODB.Recordset
      Cn.Open Cs
      Str_SQL = "delete from Spec_Bill_Temp"
      Set Rs = Cn.Execute(Str_SQL)
      If Rs.State = 1 Then Rs.Close
      Cn.Close
      
      Set Cn_SpecBill_Temp = New ADODB.Connection
      Set Rs_SpecBill_Temp = New ADODB.Recordset
      Cn_SpecBill_Temp.Open Cs
      Rs_SpecBill_Temp.Open "select * from Spec_Bill_Temp order by 规格单号,小号 ", Cn_SpecBill_Temp, adOpenKeyset, adLockOptimistic, adCmdText
      Set Me.TDBGrid_CusRiches.DataSource = Rs_SpecBill_Temp
      Call TDBGrid_Width_Set
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Str_SpecBill_ProductRequire = ""
    Str_SpecBill_ProductConsignment = ""
    Str_SpecBill_BoxSign = ""
    Str_SpecBill_ConsignmentTime = ""
    Bln_NewSpecBillRepair = False
    Bln_NewSpecBillView = False
    If Rs_SpecBill_Temp.State = 1 Then Rs_SpecBill_Temp.Close
    Cn_SpecBill_Temp.Close
    Set Rs_SpecBill_Temp = Nothing
    Set Cn_SpecBill_Temp = Nothing
    
End Sub

Private Sub TDBGrid_CusRiches_DblClick()
On Error GoTo err
  If Rs_SpecBill_Temp.EOF = False And Rs_SpecBill_Temp.BOF = False Then
    Bln_NewSpecBillRepair = False
    Bln_NewSpecBillView = True
    Load Frm_New_SpecBill_Edit
    Frm_New_SpecBill_Edit.Show vbModal
  End If
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub TDBGrid_CusRiches_FetchRowStyle(ByVal Split As Integer, Bookmark As Variant, ByVal RowStyle As TrueOleDBGrid80.StyleDisp)
On Error GoTo err
  If Me.TDBGrid_CusRiches.Columns(18).CellValue(Bookmark) >= 10000 Then RowStyle.BackColor = vbRed


Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo err
   Select Case Button.Index
         Case 3 '添加节目(Add)
             Load Frm_SpecBill_AddArt
             Frm_SpecBill_AddArt.Show vbModal
         Case 4 '修改节目(Repair)
          If Rs_SpecBill_Temp.EOF = False And Rs_SpecBill_Temp.BOF = False Then
            Bln_NewSpecBillRepair = True
            Bln_NewSpecBillView = False
            Load Frm_New_SpecBill_Edit
            Frm_New_SpecBill_Edit.Show vbModal
          End If
        Case 5 '删除节目(Delete)
          If Rs_SpecBill_Temp.EOF = False And Rs_SpecBill_Temp.BOF = False Then
             Rs_SpecBill_Temp.Delete
             Rs_SpecBill_Temp.Update
            Me.TDBGrid_CusRiches.Close
            If Rs_SpecBill_Temp.State = 1 Then Rs_SpecBill_Temp.Close
            Rs_SpecBill_Temp.Open "select * from Spec_Bill_Temp order by 规格单号,小号 ", Cn_SpecBill_Temp, adOpenKeyset, adLockOptimistic, adCmdText
            Set Me.TDBGrid_CusRiches.DataSource = Rs_SpecBill_Temp
            MsgBox "删除成功！"
            Call TDBGrid_Width_Set
          End If
        Case 6 '查看节目(View)
           If Rs_SpecBill_Temp.EOF = False And Rs_SpecBill_Temp.BOF = False Then
             Bln_NewSpecBillRepair = False
             Bln_NewSpecBillView = True
             Load Frm_New_SpecBill_Edit
             Frm_New_SpecBill_Edit.Show vbModal
           End If
         Case 7 '保存规格单(Save)
          If Rs_SpecBill_Temp.RecordCount <> 0 Then
            Rs_SpecBill_Temp.MoveFirst
            For i = 1 To Rs_SpecBill_Temp.RecordCount
              Rs_SpecBill_Temp!小号 = i
              Rs_SpecBill_Temp.MoveNext
            Next
            Rs_SpecBill_Temp.MoveFirst
            Rs_SpecBill_Temp.Update
            Frm_Whole_SpecBill.TDBGrid_CusRiches.Close
            Rs_SpecBill_Temp.MoveFirst
            Do While Not Rs_SpecBill_Temp.EOF
                If Rs_SpecBill.RecordCount <> 0 Then Rs_SpecBill.MoveLast
                Rs_SpecBill.AddNew
                '节目下单时其他要求
                If IsNull(Rs_SpecBill_Temp!规格单号) = False Then Rs_SpecBill!规格单号 = Rs_SpecBill_Temp!规格单号
                If IsNull(Rs_SpecBill_Temp!客户名称) = False Then Rs_SpecBill!客户名称 = Rs_SpecBill_Temp!客户名称
                If IsNull(Rs_SpecBill_Temp!箱面标识) = False Then Rs_SpecBill!箱面标识 = Rs_SpecBill_Temp!箱面标识
                If IsNull(Rs_SpecBill_Temp!箱号) = False Then Rs_SpecBill!箱号 = Rs_SpecBill_Temp!箱号
                If IsNull(Rs_SpecBill_Temp!合同号) = False Then Rs_SpecBill!合同号 = Rs_SpecBill_Temp!合同号
                If IsNull(Rs_SpecBill_Temp!备注) = False Then Rs_SpecBill!备注 = Rs_SpecBill_Temp!备注
                If IsNull(Rs_SpecBill_Temp!产品技术要求) = False Then Rs_SpecBill!产品技术要求 = Rs_SpecBill_Temp!产品技术要求
                If IsNull(Rs_SpecBill_Temp!产品发货要求) = False Then Rs_SpecBill!产品发货要求 = Rs_SpecBill_Temp!产品发货要求
                If IsNull(Rs_SpecBill_Temp!交货日期) = False Then Rs_SpecBill!交货日期 = Rs_SpecBill_Temp!交货日期
                If IsNull(Rs_SpecBill_Temp!订货数量) = False Then Rs_SpecBill!订货数量 = Rs_SpecBill_Temp!订货数量
                '营销部录入部份
                If IsNull(Rs_SpecBill_Temp!信息完整) = False Then Rs_SpecBill!信息完整 = Rs_SpecBill_Temp!信息完整
                If IsNull(Rs_SpecBill_Temp!质量等级) = False Then Rs_SpecBill!质量等级 = Rs_SpecBill_Temp!质量等级
                If IsNull(Rs_SpecBill_Temp!复制要求) = False Then Rs_SpecBill!复制要求 = Rs_SpecBill_Temp!复制要求
                If IsNull(Rs_SpecBill_Temp!品质要求) = False Then Rs_SpecBill!品质要求 = Rs_SpecBill_Temp!品质要求
                If IsNull(Rs_SpecBill_Temp!内编码) = False Then Rs_SpecBill!内编码 = Rs_SpecBill_Temp!内编码
                If IsNull(Rs_SpecBill_Temp!料号) = False Then Rs_SpecBill!料号 = Rs_SpecBill_Temp!料号
                If IsNull(Rs_SpecBill_Temp!节目名称) = False Then Rs_SpecBill!节目名称 = Rs_SpecBill_Temp!节目名称
                If IsNull(Rs_SpecBill_Temp!母盘号码) = False Then Rs_SpecBill!母盘号码 = Rs_SpecBill_Temp!母盘号码
                If IsNull(Rs_SpecBill_Temp!节目源种类) = False Then Rs_SpecBill!节目源种类 = Rs_SpecBill_Temp!节目源种类
                If IsNull(Rs_SpecBill_Temp!节目种类) = False Then Rs_SpecBill!节目种类 = Rs_SpecBill_Temp!节目种类
                If IsNull(Rs_SpecBill_Temp!母盘刻字要求) = False Then Rs_SpecBill!母盘刻字要求 = Rs_SpecBill_Temp!母盘刻字要求
                If IsNull(Rs_SpecBill_Temp!刻录速度) = False Then Rs_SpecBill!刻录速度 = Rs_SpecBill_Temp!刻录速度
                If IsNull(Rs_SpecBill_Temp!母盘内孔) = False Then Rs_SpecBill!母盘内孔 = Rs_SpecBill_Temp!母盘内孔
                If IsNull(Rs_SpecBill_Temp!菲林索引) = False Then Rs_SpecBill!菲林索引 = Rs_SpecBill_Temp!菲林索引
                If IsNull(Rs_SpecBill_Temp!印刷参照) = False Then Rs_SpecBill!印刷参照 = Rs_SpecBill_Temp!印刷参照
                If IsNull(Rs_SpecBill_Temp!印刷方式) = False Then Rs_SpecBill!印刷方式 = Rs_SpecBill_Temp!印刷方式
                If IsNull(Rs_SpecBill_Temp!印刷颜色) = False Then Rs_SpecBill!印刷颜色 = Rs_SpecBill_Temp!印刷颜色
                If IsNull(Rs_SpecBill_Temp!委托书编码) = False Then Rs_SpecBill!委托书编码 = Rs_SpecBill_Temp!委托书编码
                If IsNull(Rs_SpecBill_Temp!印刷要求) = False Then Rs_SpecBill!印刷要求 = Rs_SpecBill_Temp!印刷要求
                If IsNull(Rs_SpecBill_Temp!包装要求) = False Then Rs_SpecBill!包装要求 = Rs_SpecBill_Temp!包装要求
                If IsNull(Rs_SpecBill_Temp!包装方式) = False Then Rs_SpecBill!包装方式 = Rs_SpecBill_Temp!包装方式
                '品质部录入部分
                If IsNull(Rs_SpecBill_Temp!母盘数量) = False Then Rs_SpecBill!母盘数量 = Rs_SpecBill_Temp!母盘数量
                If IsNull(Rs_SpecBill_Temp!节目源状态) = False Then Rs_SpecBill!节目源状态 = Rs_SpecBill_Temp!节目源状态
                If IsNull(Rs_SpecBill_Temp!印刷内圈) = False Then Rs_SpecBill!印刷内圈 = Rs_SpecBill_Temp!印刷内圈
                If IsNull(Rs_SpecBill_Temp!菲林状态) = False Then Rs_SpecBill!菲林状态 = Rs_SpecBill_Temp!菲林状态
            '    If IsNull(Rs_SpecBill_Temp!特殊防尘垫要求) = False Then Me.txt_Q_Fields(1).text = Rs_SpecBill_Temp!特殊防尘垫要求 Else Me.txt_Q_Fields(1).text = ""
            '    If IsNull(Rs_SpecBill_Temp!特殊箱唛标识) = False Then Me.txt_Q_Fields(2).text = Rs_SpecBill_Temp!特殊箱唛标识 Else Me.txt_Q_Fields(2).text = ""
                If IsNull(Rs_SpecBill_Temp!库位号) = False Then Rs_SpecBill!库位号 = Rs_SpecBill_Temp!库位号
                If IsNull(Rs_SpecBill_Temp!财产备注) = False Then Rs_SpecBill!财产备注 = Rs_SpecBill_Temp!财产备注
                '生产部录入部分
                If IsNull(Rs_SpecBill_Temp!印刷机号) = False Then Rs_SpecBill!印刷机号 = Rs_SpecBill_Temp!印刷机号
                If IsNull(Rs_SpecBill_Temp!版状态) = False Then Rs_SpecBill!版状态 = Rs_SpecBill_Temp!版状态
                If IsNull(Rs_SpecBill_Temp!专色油墨) = False Then Rs_SpecBill!专色油墨 = Rs_SpecBill_Temp!专色油墨
                If IsNull(Rs_SpecBill_Temp!颜色样本) = False Then Rs_SpecBill!颜色样本 = Rs_SpecBill_Temp!颜色样本
                If IsNull(Rs_SpecBill_Temp!不良率) = False And Rs_SpecBill_Temp!不良率 <> "" Then Rs_SpecBill!不良率 = Rs_SpecBill_Temp!不良率
                If IsNull(Rs_SpecBill_Temp!剩余良品数) = False Then Rs_SpecBill!剩余良品数 = Rs_SpecBill_Temp!剩余良品数
                If IsNull(Rs_SpecBill_Temp!小于3000) = False Then Rs_SpecBill!小于3000 = Rs_SpecBill_Temp!小于3000
                Rs_SpecBill!小号 = Rs_SpecBill_Temp!小号
                Rs_SpecBill.Update
                Rs_SpecBill_Temp.MoveNext
            Loop
            If Rs_SpecBill.State = 1 Then Rs_SpecBill.Close
            Rs_SpecBill.Open "select * from Spec_Bill order by 规格单号,小号", Cn_SpecBill, adOpenKeyset, adLockOptimistic, adCmdText
            If Rs_SpecBill.RecordCount <> 0 Then Rs_SpecBill.MoveLast
            Set Frm_Whole_SpecBill.TDBGrid_CusRiches.DataSource = Rs_SpecBill
            Call Frm_Whole_SpecBill.TDBGrid_Width_Set
          End If
          Unload Me
         Case 8 '退出下单(Exit)
            If MsgBox("你保存此次规格单单了吗?" + Chr(13) + "如果没有保存会造成此次信息数据丢失!" + Chr(13) + "单击“是”退出,单击“否”先进行保存.", vbQuestion + vbYesNo) = vbYes Then Unload Me
        
  End Select
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub