frm_whole_specbill.frm

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

      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   10
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Object.Visible         =   0   'False
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Object.Visible         =   0   'False
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "新建规格单(New)"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "修改信息(Repair)"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除信息(Delete)"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "查看信息(View)"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "信息查找(Find)"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "导出Excel(Enter)"
            ImageIndex      =   6
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "生成箱唛(BoxSign)"
            ImageIndex      =   8
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出(Exit)"
            ImageIndex      =   7
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Frm_Whole_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 48
    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 = 1200
  Me.TDBGrid_CusRiches.Columns(1).Width = 600
  Me.TDBGrid_CusRiches.Columns(2).Width = 400
  Me.TDBGrid_CusRiches.Columns(3).Width = 400
  Me.TDBGrid_CusRiches.Columns(4).Width = 400
  Me.TDBGrid_CusRiches.Columns(5).Width = 400
  Me.TDBGrid_CusRiches.Columns(6).Width = 400
  Me.TDBGrid_CusRiches.Columns(7).Width = 400
  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 = 900
  Me.TDBGrid_CusRiches.Columns(40).Width = 900
  Me.TDBGrid_CusRiches.Columns(41).Width = 900
  Me.TDBGrid_CusRiches.Columns(42).Width = 800
  Me.TDBGrid_CusRiches.Columns(43).Width = 800
  Me.TDBGrid_CusRiches.Columns(44).Width = 900
  Me.TDBGrid_CusRiches.Columns(45).Width = 900
  Me.TDBGrid_CusRiches.Columns(46).Width = 900
  Me.TDBGrid_CusRiches.Columns(47).Width = 800
  Me.TDBGrid_CusRiches.Columns(48).Width = 600
  Me.TDBGrid_CusRiches.Columns(18).NumberFormat = "#,###,###"
'  Me.TDBGrid_CusRiches.Columns(18).EditMaskUpdate = True
'  Me.TDBGrid_CusRiches.Columns(18).EditMask = "##,###"
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_SpecBill = New ADODB.Connection
    Set Rs_SpecBill = New ADODB.Recordset
    Cn_SpecBill.Open Cs
    Rs_SpecBill.Open "select * from Spec_Bill  order by 规格单号,小号", Cn_SpecBill, adOpenKeyset, adLockOptimistic, adCmdText
    If Rs_SpecBill.RecordCount <> 0 Then Rs_SpecBill.MoveLast
    Set TDBGrid_CusRiches.DataSource = Rs_SpecBill
    Call TDBGrid_Width_Set
    If OperatorDepartment <> "营销部" Then
       Me.Toolbar1.Buttons(3).Enabled = False
       Me.Toolbar1.Buttons(4).Enabled = False
       Me.Toolbar1.Buttons(5).Enabled = False
    End If
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
  If Rs_SpecBill.State = 1 Then
    Rs_SpecBill.Close
    Cn_SpecBill.Close
  End If
  Set Rs_SpecBill = Nothing
  Set Cn_SpecBill = Nothing
  Bln_SpecBillRepair = False
  Bln_SpecBillView = False
  
End Sub

Private Sub TDBGrid_CusRiches_DblClick()
On Error GoTo err
    Bln_SpecBillRepair = False
    Bln_SpecBillView = True
    Load Frm_SpecBill_View
    Frm_SpecBill_View.Show vbModal
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 '新建规格单(New)
            Load Frm_New_SpecBill
            Frm_New_SpecBill.Show vbModal
        Case 4 '修改信息(Repair)
         If Rs_SpecBill.EOF = False And Rs_SpecBill.BOF = False Then
           Bln_SpecBillRepair = True
           Bln_SpecBillView = False
           Load Frm_SpecBill_View
           Frm_SpecBill_View.Show vbModal
         End If
        Case 5 '删除信息(Delete)
          If MsgBox("你确认删除此规格单的此款节目吗?" + Chr(13) + "单击“是”删除,单击“否”取消删除.", vbQuestion + vbYesNo) = vbYes Then
            If Rs_SpecBill.EOF = False And Rs_SpecBill.BOF = False Then
              Set Cn = New ADODB.Connection
              Set Rs = New ADODB.Recordset
              Cn.Open Cs
              Rs.Open "select * from Spec_Bill where 内编码='" & Rs_SpecBill!内编码 & "' and 规格单号='" & Rs_SpecBill!规格单号 & "' and 小号='" & Rs_SpecBill!小号 & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
              Rs.Delete
              Rs.Update
              Rs.Close
              Cn.Close
              Me.TDBGrid_CusRiches.Close
              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 Me.TDBGrid_CusRiches.DataSource = Rs_SpecBill
              Call TDBGrid_Width_Set
            End If
           End If
        Case 6 '查看信息(View)
         If Rs_SpecBill.EOF = False And Rs_SpecBill.BOF = False Then
           Bln_SpecBillRepair = False
           Bln_SpecBillView = True
           Load Frm_SpecBill_View
           Frm_SpecBill_View.Show vbModal
         End If
        Case 7 '查找信息(Find)
          Load Frm_SpecBill_Find
          Frm_SpecBill_Find.Show vbModal
        Case 8 '导出Excel(Enter)
          Load Frm_Spec_Bill_Export
          Frm_Spec_Bill_Export.Show vbModal
        Case 9 '生成箱唛
          Load Frm_BoxSign
          Frm_BoxSign.Show vbModal
        Case 10 '退出(Exit)
          Unload Me
  End Select
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub