公司信息

Option Explicit
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
   
    Set 公司名称.DataSource = Adodc1
    Set 地址.DataSource = Adodc1
    Set 城市.DataSource = Adodc1
    Set 省份.DataSource = Adodc1
    Set 国家.DataSource = Adodc1
    Set 邮政编码.DataSource = Adodc1
    Set 电话号码.DataSource = Adodc1
    Set 电子邮件.DataSource = Adodc1
    Set 传真号码.DataSource = Adodc1
    Set 开户银行.DataSource = Adodc1
    Set 银行帐号.DataSource = Adodc1
    Set 业务描述.DataSource = Adodc1
   
   
    Adodc1.Refresh
    Adodc1.Visible = False
   
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.update
   
    ';写入系统日志
    fMainForm.WriteLog ("查看或修改了公司信息")
End Sub
Private Sub 业务描述_Change()
End Sub

供应商
Private m_IsAdd As Boolean
Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean

Option Explicit
Private Sub initdatagrid1()
    DataGrid1.Columns(0).Locked = True ';编号
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1300
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 1000
    DataGrid1.Columns(7).width = 1000
    DataGrid1.Columns(8).width = 1000
    DataGrid1.Columns(9).width = 1000
    DataGrid1.Columns(10).width = 1000
    DataGrid1.Columns(11).width = 1000
    DataGrid1.Columns(12).width = 1000
    DataGrid1.Columns(13).width = 1000
    DataGrid1.Columns(14).width = 1000
   
    DataGrid1.rowheight = 270
End Sub
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
End Sub

Private Sub DataGrid1_AfterDelete()
    ';写入系统日志
    fMainForm.WriteLog ("删除供应商")
End Sub
Private Sub DataGrid1_AfterUpdate()
    ';写入系统日志
    fMainForm.WriteLog ("更新供应商")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
   
   ';判断是否其它表单用了待删除的职员编号
    Dim code As String
    Dim rs As String
    code = DataGrid1.Columns(0).Text
   
    rs = ""
    rs = rs + "select 经办人编号 from 入库单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 借入单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 借出单 where 经办人编号=" + Str(code)
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此供应商信息,不能删除!", vbExclamation
        Cancel = True
    End If
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    Adodc1.Visible = False
   
    initdatagrid1
   
End Sub
Private Sub DataGrid1_OnAddNew()
    DataGrid1.Columns(0).Locked = False
    m_IsAdd = True
   
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd = False Then
        DataGrid1.Columns(0).Locked = True
    Else
        m_IsAdd = False
    End If
   
End Sub

货物出入统计

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(8) As Long
Private order(8) As Boolean
Option Explicit
Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1600
    DataGrid1.Columns(2).width = 800
    DataGrid1.Columns(3).width = 800
    DataGrid1.Columns(4).width = 800
    DataGrid1.Columns(5).width = 800
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
   
    DataGrid1.rowheight = 270
End Sub
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
    If ColIndex > 1 Then Exit Sub
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    Adodc1.Visible = False
   
    Adodc2.ConnectionString = DataConnectString
    Set DataCombo1.RowSource = Adodc2
    DataCombo1.ListField = "仓库名称"
    Adodc2.Refresh
    Adodc2.Visible = False
   
    T出入时间.Text = "无限制"
   
    进行统计_Click
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SQL = ""
End Sub

Private Sub 打印_Click(Index As Integer)
End Sub

货物信息

Private m_IsAdd1 As Boolean
Private m_IsAdd2 As Boolean
Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean

Option Explicit
Private Sub InitDataGrid2()
    DataGrid2.Columns(0).Locked = True ';编号
    DataGrid2.Columns(2).Locked = True ';类别编号
    DataGrid2.Columns(0).width = 500
    DataGrid2.Columns(1).width = 1500
    DataGrid2.Columns(2).width = 800
    DataGrid2.Columns(3).width = 1200
    DataGrid2.Columns(4).width = 800
    DataGrid2.Columns(5).width = 800
    DataGrid2.Columns(6).width = 800
    DataGrid2.Columns(7).width = 1200
   
    If Adodc2.Recordset.RecordCount > 0 Then
        Adodc2.Recordset.MoveLast
        货物编号.Text = Adodc2.Recordset.Fields("编号").Value + 1
        Adodc2.Recordset.MoveFirst
    Else
        货物编号.Text = 1
    End If
   
End Sub
Private Sub SaveInit()
   
    startcol = DataGrid2.SelStartCol
    endcol = DataGrid2.SelEndCol
    col = DataGrid2.LeftCol
    row = DataGrid2.row
   
    rowheight = DataGrid2.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid2.Columns.count - 1
        colwidth(i) = DataGrid2.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid2.SelStartCol = startcol
    DataGrid2.SelEndCol = endcol
    DataGrid2.Scroll col, row
   
    DataGrid2.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid2.Columns.count - 1
         DataGrid2.Columns(i).width = colwidth(i)
    Next
   
End Sub
Private Sub initdatagrid1()
    DataGrid1.Columns(0).Locked = True
   
    DataGrid1.Columns(0).width = 1200
    DataGrid1.Columns(1).width = 1000
   
    DataGrid1.AllowRowSizing = False
    DataGrid1.Columns(0).AllowSizing = False
    DataGrid1.Columns(1).AllowSizing = False
   
End Sub

Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("类别名称").Value
   
End Sub

Private Sub Adodc2_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc2.caption = Adodc2.Recordset.Fields("货物名称").Value
   
End Sub
Private Sub DataGrid1_AfterDelete()
  ';写入系统日志
    fMainForm.WriteLog ("删除货物类别")
End Sub
Private Sub DataGrid1_AfterInsert()
';写入系统日志
    fMainForm.WriteLog ("增加货物类别")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
    fMainForm.WriteLog ("更新货物类别")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
     
    On Error Resume Next
      
    ';判断是否其它表单用了待删除的货物类别
    Dim name As String
    Dim rs As String
    name = DataGrid1.Columns(0).Text
   
    rs = "select 货物信息.编号 from 货物信息,货物类别"
    rs = rs + " Where 货物信息.货物类别=';": rs = rs + name: rs = rs + "';"
   
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此货物类别信息,不能删除!", vbExclamation
        Cancel = True
    End If
   
End Sub
Private Sub DataGrid1_OnAddNew()
    DataGrid1.Columns(0).Locked = False
    m_IsAdd1 = True
   
End Sub
   
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd1 = False Then
        DataGrid1.Columns(0).Locked = True
    Else
        m_IsAdd1 = False
    End If
   
End Sub
Private Sub DataGrid2_AfterColUpdate(ByVal ColIndex As Integer)
    If ColIndex = 0 Then DataGrid2.Columns(2).Value = 货物类别.Text
   
End Sub

Private Sub DataGrid2_AfterDelete()
      ';写入系统日志
    fMainForm.WriteLog ("删除货物")
End Sub
Private Sub DataGrid2_AfterUpdate()
  ';写入系统日志
    fMainForm.WriteLog ("更新货物")
End Sub
Private Sub DataGrid2_BeforeDelete(Cancel As Integer)
     On Error Resume Next
    ';判断是否其它表单用了待删除的货物编号
    Dim code As String
    Dim rs As String
    code = DataGrid2.Columns(0).Text
   
    rs = ""
    rs = rs + "select 货物编号 from 入库单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 出库单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 借入单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 借出单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 调拔单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 报损单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 库存状况 where 货物编号=" + Str(code)
   
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此货物信息,不能删除!", vbExclamation
        Cancel = True
    End If
   
End Sub
Private Sub DataGrid2_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid2.Columns(ColIndex).caption
   
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc2.RecordSource = SQL + " order by " + caption

    order(ColIndex) = True - order(ColIndex)
   
    If order(ColIndex) = True Then
        Adodc2.RecordSource = Adodc2.RecordSource + " ASC"
    Else
        Adodc2.RecordSource = Adodc2.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc2.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid2_OnAddNew()
    DataGrid2.Columns(0).Locked = False
    m_IsAdd2 = True
   
End Sub
   
Private Sub DataGrid2_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd2 = False Then
        DataGrid2.Columns(0).Locked = True
    Else
        m_IsAdd2 = False
    End If
   
End Sub
Private Sub Form_Load()
    ';初始化货物类别
    Adodc1.ConnectionString = DataConnectString
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    ';Adodc1.Visible = False
    initdatagrid1
   
    ';初始化货物信息
    Adodc2.ConnectionString = DataConnectString
    SQL = Adodc2.RecordSource
    Set DataGrid2.DataSource = Adodc2
    Adodc2.Refresh
    ';Adodc2.Visible = False
    ';设置DataGrid2属性
    InitDataGrid2
    ';增加新货物控件
    Set 货物类别.DataSource = Adodc1
    货物类别.DataField = "类别名称"
   
End Sub
Private Sub 更换类别_Click()
    DataGrid2.Columns(2).Value = 货物类别.Text
     ';写入系统日志
    fMainForm.WriteLog ("更新货物类别")
   
End Sub
Private Sub 货物类别_GotFocus()
    货物类别.Enabled = False
End Sub
Private Sub 货物类别_LostFocus()
    货物类别.Enabled = True
End Sub
Private Sub 删除货物_Click()
    On Error Resume Next
    ';判断是否其它表单用了待删除的货物编号
    Dim code As String
    Dim rs As String
    code = DataGrid2.Columns(0).Text
   
    rs = ""
    rs = rs + "select 货物编号 from 入库单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 出库单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 借入单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 借出单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 调拔单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 报损单 where 货物编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 货物编号 from 库存状况 where 货物编号=" + Str(code)
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
   
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此货物信息,不能删除!", vbExclamation
    Else
        fMainForm.m_checkado.RecordSource = "select * from 货物信息 where 编号=" + DataGrid2.Columns(0).Text
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        
        SaveInit
        Adodc2.Refresh
        ResumeInit
        
         ';写入系统日志
        fMainForm.WriteLog ("删除货物")
   
    End If
   
End Sub
Private Sub 增加新货物_Click()
    If 货物编号.Text = "" Then MsgBox "请填写货物编号!", vbQuestion: Exit Sub
    If 货物名称.Text = "" Then MsgBox "请填写货物名称!", vbQuestion: Exit Sub
    If 最低限量.Text = "" Then MsgBox "请填写最低限量!", vbQuestion: Exit Sub
    If 最高限量.Text = "" Then MsgBox "请填写最高限量!", vbQuestion: Exit Sub
    If 计量单位.Text = "" Then MsgBox "请填写计量单位!", vbQuestion: Exit Sub
   
    On Error Resume Next
   
    SaveInit
   
    Adodc2.Recordset.AddNew
    Adodc2.Recordset.Fields("编号") = 货物编号.Text
    Adodc2.Recordset.Fields("货物名称") = 货物名称.Text
    Adodc2.Recordset.Fields("货物类别") = DataGrid1.Columns(0).Text
    Adodc2.Recordset.Fields("货物规格") = 货物规格.Text
    Adodc2.Recordset.Fields("计量单位") = 计量单位.Text
    Adodc2.Recordset.Fields("最低限量") = 最低限量.Text
    Adodc2.Recordset.Fields("最高限量") = 最高限量.Text
    Adodc2.Recordset.Fields("备注") = 备注.Text
   
    Adodc2.Recordset.update
    Adodc2.Recordset.Requery
   
   
    Adodc2.Refresh
    ResumeInit
   
    货物编号.Text = 货物编号.Text + 1
   
     ';写入系统日志
    fMainForm.WriteLog ("增加新货物")
   
End Sub

借出单

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean
Option Explicit
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
End Sub

Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1000
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).width = 800
    DataGrid1.Columns(12).width = 800
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
    DataGrid1.rowheight = 270
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("货物名称").Value
   
End Sub

Private Sub B新增借出单_Click()
    新增借出单.Show vbModal
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    If caption = "经办人" Then caption = "姓名"
    If caption = "金额" Then Exit Sub
    If caption = "备注" Then caption = "借出单.备注"
    If caption = "编号" Then caption = "借出单.编号"
    If caption = "供应商" Then caption = "供应商名称"
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    initdatagrid1
   
    ';通过权限来初始化控件性质
    If 权限类别(0) = 0 Then B新增借出单.Enabled = False
    If 权限类别(1) = 0 Then DataGrid1.AllowUpdate = False
    If 权限类别(2) = 0 Then
        退出借出单.Enabled = False
        删除借出单.Enabled = False
    End If
    If 权限类别(8) = 0 Then 打印借出单.Enabled = False
   
End Sub

Private Sub 打印借出单_Click()
   On Error GoTo quit
    Dim p As New 新增借出单
    p.编号 = DataGrid1.Columns(0).Value
    p.Show vbModal
   
    Unload p
   
quit:
   
End Sub
Private Sub 删除借出单_Click()
    On Error GoTo quit
    If DataGrid1.Columns(10).Text = "已还入" Then GoTo con
    If MsgBox("建议用[退出借出单],而不要直接删除,以免数据丢失.您确信要删除该借出单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
con:
   
    On Error Resume Next
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,借出数量,仓库编号 from 借出单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("借出数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    ';如果是已退出借出单则直接删除
    If DataGrid1.Columns(12).Text = "已还入" Then
        If MsgBox("您确信要删除该借出退出单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
   
        fMainForm.m_checkado.RecordSource = "select * from 借出单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        Exit Sub
    End If
   
    fMainForm.m_checkado.RecordSource = "select (货物信息.最高限量-库存数量) as 剩余量 from 库存状况,货物信息 where 货物信息.编号=库存状况.货物编号 and 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("剩余量").Value
    ';库存不足
    If num2 < num1 Then
        If MsgBox("库存超额,库存最大剩余限量为" + Str(num2) + ",入库量为" + Str(num1) + "," + "要忽略它并强制删除吗?", vbQuestion Or vbYesNo) = vbNo Then Exit Sub
    End If
   
     ';更新库存状况
    fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';如果已有记录则更新
     If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
         If num2 - num1 > 0 Then ';剩余限量够
             fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num1
             fMainForm.m_checkado.Recordset.update
         Else
             fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num2
             fMainForm.m_checkado.Recordset.update
         End If
    Else ';没有记录开始创建
         fMainForm.m_checkado.RecordSource = "select * from 库存状况"
         fMainForm.m_checkado.Refresh
            
         ';移到记录最后
         Dim ncode As Long
         If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
              fMainForm.m_checkado.Recordset.MoveLast
              ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1
         Else
              ncode = 1
         End If
            
         fMainForm.m_checkado.Recordset.AddNew
            
         fMainForm.m_checkado.Recordset.Fields("编号") = ncode
         fMainForm.m_checkado.Recordset.Fields("货物编号") = code1
         fMainForm.m_checkado.Recordset.Fields("仓库编号") = code2
         If num2 > num1 Then
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num1
         Else
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num2
         End If
         
         fMainForm.m_checkado.Recordset.update
            
    End If
    fMainForm.m_checkado.Refresh
    ';更新借出单
    fMainForm.m_checkado.RecordSource = "select * from 借出单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
    fMainForm.m_checkado.Recordset.Delete
    fMainForm.m_checkado.Refresh
        
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    MsgBox "借出单删除成功!"
    ';写入系统日志
    fMainForm.WriteLog ("删除借出单")
quit:
   
End Sub
Private Sub 退出借出单_Click()
    On Error GoTo quit
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
    If DataGrid1.Columns(10).Text = "已还入" Then
        MsgBox "该借出单已还入!"
        Exit Sub
    End If
   
    On Error Resume Next
    fMainForm.m_checkado.RecordSource = "select 货物编号,借出数量,仓库编号 from 借出单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("借出数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + Str(code1)
    fMainForm.m_checkado.Refresh
    num2 = fMainForm.m_checkado.Recordset.Fields("最高限量").Value
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        num2 = num2 - fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    End If
    ';库存不足
    If num2 < num1 Then
        MsgBox "库存超额,库存最大剩余限量为" + Str(num2) + ",入库量为" + Str(num1) + "."
        Exit Sub
    Else
   
    ';更新库存状况
    fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';如果已有记录则更新
     If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
         If num2 - num1 > 0 Then ';剩余限量够
             fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num1
             fMainForm.m_checkado.Recordset.update
         Else
             fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num2
             fMainForm.m_checkado.Recordset.update
         End If
    Else ';没有记录开始创建
         fMainForm.m_checkado.RecordSource = "select * from 库存状况"
         fMainForm.m_checkado.Refresh
            
         ';移到记录最后
         Dim ncode As Long
         If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
              fMainForm.m_checkado.Recordset.MoveLast
              ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1
         Else
              ncode = 1
         End If
            
         fMainForm.m_checkado.Recordset.AddNew
            
         fMainForm.m_checkado.Recordset.Fields("编号") = ncode
         fMainForm.m_checkado.Recordset.Fields("货物编号") = code1
         fMainForm.m_checkado.Recordset.Fields("仓库编号") = code2
         If num2 > num1 Then
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num1
         Else
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num2
         End If
         
         fMainForm.m_checkado.Recordset.update
            
    End If
    fMainForm.m_checkado.Refresh
        
    ';更新借出单
        fMainForm.m_checkado.RecordSource = "select * from 借出单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Fields("定单状况") = "已还入"
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        
        MsgBox "借出单退出成功!"
        
        ';写入系统日志
        fMainForm.WriteLog ("退出借出单")
    End If
   
quit:
End Sub

借入单

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean
Option Explicit
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
End Sub

Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1000
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).width = 800
    DataGrid1.Columns(12).width = 800
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
    DataGrid1.rowheight = 270
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("货物名称").Value
   
End Sub

Private Sub B新增借入单_Click()
    新增借入单.Show vbModal
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    If caption = "经办人" Then caption = "姓名"
    If caption = "金额" Then Exit Sub
    If caption = "备注" Then caption = "借入单.备注"
    If caption = "编号" Then caption = "借入单.编号"
    If caption = "供应商" Then caption = "供应商名称"
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    initdatagrid1
   
     ';通过权限来初始化控件性质
    If 权限类别(0) = 0 Then B新增借入单.Enabled = False
    If 权限类别(1) = 0 Then DataGrid1.AllowUpdate = False
    If 权限类别(2) = 0 Then
        退出借入单.Enabled = False
        删除借入单.Enabled = False
    End If
    If 权限类别(8) = 0 Then 打印借入单.Enabled = False
   
End Sub
Private Sub 打印借入单_Click()
    On Error GoTo quit
    Dim p As New 新增借入单
    p.编号 = DataGrid1.Columns(0).Value
    p.Show vbModal
   
    Unload p
   
quit:
   
End Sub
Private Sub 删除借入单_Click()
   
    On Error GoTo quit
    If DataGrid1.Columns(10).Text = "已还出" Then GoTo con
    If MsgBox("建议用[退出借入单],而不要直接删除,以免数据丢失.您确信要删除该借入单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
con:
   
    On Error Resume Next
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,借入数量,仓库编号 from 借入单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("借入数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    ';如果是已退出借入单则直接删除
    If DataGrid1.Columns(12).Text = "已还出" Then
        If MsgBox("您确信要删除该借入退出单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
   
        fMainForm.m_checkado.RecordSource = "select * from 借入单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        Exit Sub
    End If
   
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    ';库存不足
    If num2 < num1 Then
        If MsgBox("库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "," + "要忽略它并强制删除吗?", vbQuestion Or vbYesNo) = vbNo Then Exit Sub
    End If
    ';更新库存状况
    If num2 - num1 > 0 Then
        fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
        fMainForm.m_checkado.Recordset.update
    Else ';如果库存为零清空
        fMainForm.m_checkado.Recordset.Delete
    End If
   
    fMainForm.m_checkado.Refresh
    ';更新借入单
    fMainForm.m_checkado.RecordSource = "select * from 借入单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
    fMainForm.m_checkado.Recordset.Delete
    fMainForm.m_checkado.Refresh
        
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    MsgBox "借入单删除成功!"
    ';写入系统日志
    fMainForm.WriteLog ("删除借入单")
quit:
End Sub
Private Sub 退出借入单_Click()
    On Error GoTo quit
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
    If DataGrid1.Columns(10).Text = "已还出" Then
        MsgBox "该借入单已还出!"
        Exit Sub
    End If
   
    On Error Resume Next
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,借入数量,仓库编号 from 借入单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("借入数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    ';库存不足
    If num2 < num1 Then
        MsgBox "库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "."
        Exit Sub
    Else
    ';更新库存状况
        If num2 - num1 > 0 Then
            fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
            fMainForm.m_checkado.Recordset.update
        Else ';如果库存为零清空
            fMainForm.m_checkado.Recordset.Delete
        End If
        fMainForm.m_checkado.Refresh
    ';更新借入单
        fMainForm.m_checkado.RecordSource = "select * from 借入单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Fields("定单状况") = "已还出"
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        
        MsgBox "借入单退出成功!"
        ';写入系统日志
        fMainForm.WriteLog ("退出借入单")
    End If
   
quit:
End Sub

客户

Private m_IsAdd As Boolean
Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean

Option Explicit
Private Sub initdatagrid1()
    DataGrid1.Columns(0).Locked = True ';编号
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1200
    DataGrid1.Columns(2).width = 600
    DataGrid1.Columns(3).width = 800
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 1000
    DataGrid1.Columns(7).width = 1000
    DataGrid1.Columns(8).width = 1000
    DataGrid1.Columns(9).width = 1000
    DataGrid1.Columns(10).width = 1000
   
    DataGrid1.rowheight = 270
End Sub
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
End Sub

Private Sub DataGrid1_AfterDelete()
    ';写入系统日志
    fMainForm.WriteLog ("删除客户")
End Sub
Private Sub DataGrid1_AfterInsert()
    ';写入系统日志
    fMainForm.WriteLog ("增加客户")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
    fMainForm.WriteLog ("更新客户")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
    On Error Resume Next

    ';判断是否其它表单用了待删除的客户编号
    Dim code As String
    Dim rs As String
    code = DataGrid1.Columns(0).Text
   
    rs = ""
    rs = rs + "select 经办人编号 from 出库单 where 经办人编号=" + Str(code)
   
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此客户信息,不能删除!", vbExclamation
        Cancel = True
    End If
   
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    Adodc1.Visible = False
   
    initdatagrid1
   
End Sub
Private Sub DataGrid1_OnAddNew()
    DataGrid1.Columns(0).Locked = False
    m_IsAdd = True
   
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd = False Then
        DataGrid1.Columns(0).Locked = True
    Else
        m_IsAdd = False
    End If
   
End Sub

库存查询 Private SQL As String Private 仓库编号 As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 500 DataGrid1.Columns(1).width = 800 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 800 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 DataGrid1.Columns(9).width = 0 End Sub Private Sub updatecolumns() Dim d As Integer Dim inttype As Integer If DataGrid1.Columns.count <= 2 Then d = 600 Else d = 50 End If Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = Len(DataGrid1.Columns(i).caption) * d inttype = Adodc1.Recordset.Fields(i).Type Select Case inttype Case dbBoolean DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbByte DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbInteger DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbLong DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbCurrency DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbSingle DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 600 Case dbDouble DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 700 Case dbDate DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 800 Case dbText DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 900 Case dbLongBinary DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbMemo DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbGUID DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case Else DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 End Select Next End Sub Private Sub DataCombo1_Change() Option1.Value = False Option2.Value = False Option3.Value = False End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Adodc1.Visible = False Adodc2.ConnectionString = DataConnectString Set DataCombo1.RowSource = Adodc2 DataCombo1.ListField = "仓库名称" Adodc2.Refresh Adodc2.Visible = False T库存数量.Text = "无限制" End Sub Private Sub Option1_Click() update End Sub Private Sub update() If DataCombo1.Text = "" Then MsgBox "请选择仓库名称!" Exit Sub End If On Error GoTo quit ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value If Option1.Value = True Then Adodc1.RecordSource = "select * from 货物信息 where 编号 not in (select 货物编号 from 库存状况 where 仓库编号=" + 仓库编号 + ")" Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns ElseIf Option2.Value = True Then Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,货物信息.计量单位,库存状况.库存数量,货物信息.最低限量,仓库.仓库名称 as 存放仓库,货物信息.备注 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号 and 库存数量<=货物信息.最低限量 and 库存状况.仓库编号=" + 仓库编号 Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns ElseIf Option3.Value = True Then Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,货物信息.计量单位,库存状况.库存数量,货物信息.最高限量,仓库.仓库名称 as 存放仓库,货物信息.备注 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号 and 库存数量>=货物信息.最高限量 and 库存状况.仓库编号=" + 仓库编号 Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns End If quit: End Sub Private Sub Option2_Click() update End Sub Private Sub Option3_Click() update End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "库存查询" End Sub Private Sub 货物规格_DblClick() On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物规格 from 货物信息" sel.title = "请选择货物规格" sel.Show vbModal If sel.result2 <> "" Then 货物规格.Text = sel.result2 Unload sel End Sub Private Sub 货物类别_DblClick() On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 类别名称,备注 from 货物类别" sel.title = "请选择货物类别" sel.Show vbModal If sel.result1 <> "" Then 货物类别.Text = sel.result1 Unload sel End Sub Private Sub 货物名称_DblClick() On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称 from 货物信息" sel.title = "请选择货物名称" sel.Show vbModal If sel.result2 <> "" Then 货物名称.Text = sel.result2 Unload sel End Sub Private Sub 执行查询_Click() If DataCombo1.Text = "" Then MsgBox "请选择仓库名称!" Exit Sub End If On Error GoTo quit ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value Dim s As String s = SQL ';处理s ';加上仓库编号 s = s + " and 库存状况.仓库编号=" + 仓库编号 If 货物名称.Text <> "" Then s = s + " and 货物信息.货物名称 like ';%" + 货物名称.Text + "%';" End If If 货物类别.Text <> "" Then s = s + " and 货物信息.货物类别 like ';%" + 货物类别.Text + "%';" End If If 货物规格.Text <> "" Then s = s + " and 货物信息.货物规格 like ';%" + 货物规格.Text + "%';" End If If T库存数量.Text <> "无限制" And 库存数量.Text <> "" Then s = s + " and 库存状况.库存数量" + T库存数量.Text + 库存数量.Text End If Adodc1.RecordSource = s Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh initdatagrid1 quit: End Sub

库存状况 Dim SQL As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 800 DataGrid1.Columns(1).width = 800 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 1000 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 DataGrid1.Columns(9).width = 800 End Sub Private Sub DataCombo1_Change() 限定仓库.Value = 0 End Sub Private Sub DataGrid1_Click() End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Adodc1.Visible = False Adodc2.ConnectionString = DataConnectString Set DataCombo1.RowSource = Adodc2 DataCombo1.ListField = "仓库名称" Adodc2.Refresh Adodc2.Visible = False initdatagrid1 End Sub Private Sub update() If 限定仓库.Value = 1 And DataCombo1.Text = "" Then MsgBox "请选择仓库!": Exit Sub Dim 仓库编号 As String On Error Resume Next ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value If 限定仓库.Value = 1 And DataCombo1.Text <> "" Then Adodc1.RecordSource = SQL + " and 库存状况.仓库编号=" + 仓库编号 Else Adodc1.RecordSource = SQL End If Adodc1.Refresh initdatagrid1 End Sub Private Sub 限定仓库_Click() update End Sub

权限选择

Public Purview As Long
Option Explicit

Private Sub Form_Resize()
   
    ';初始化各checkbox
    Dim i As Integer
   
    For i = 16 To 0 Step -1
        If GetBit(Purview, i + 1) = 0 Then
            Check(16 - i).Value = 0
        Else
            Check(16 - i).Value = 1
        End If
    Next
   
End Sub
Private Sub 取消_Click()
    Unload Me
End Sub
Private Sub 全部选中_Click()
    Dim i As Integer
   
    For i = 0 To 16
        If Check(i).Enabled = True Then Check(i).Value = 1
    Next
   
End Sub
Private Sub 修改权限_Click()
   
    Dim i As Integer
    Dim s As String
    s = ""
   
    For i = 16 To 0 Step -1
        s = s + LTrim(Str(Check(i).Value))
    Next
   
    Purview = GetBits(s, 17)
   
    Unload Me
   
End Sub

入库单

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean
Option Explicit
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
    DataGrid1.Columns(11).Locked = True
    DataGrid1.Columns(12).Locked = True
   
End Sub

Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1000
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).width = 800
    DataGrid1.Columns(12).width = 800
    DataGrid1.Columns(13).width = 800
    DataGrid1.Columns(14).width = 800
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
    DataGrid1.Columns(11).Locked = True
    DataGrid1.Columns(12).Locked = True
   
    DataGrid1.rowheight = 270
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("货物名称").Value
   
End Sub

Private Sub B新增入库单_Click()
    新增入库单.Show vbModal
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    If caption = "经办人" Then caption = "姓名"
    If caption = "金额" Then Exit Sub
    If caption = "备注" Then caption = "入库单.备注"
    If caption = "编号" Then caption = "入库单.编号"
    If caption = "供应商" Then caption = "供应商名称"
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    initdatagrid1
   
    ';通过权限来初始化控件性质
    If 权限类别(0) = 0 Then B新增入库单.Enabled = False
    If 权限类别(1) = 0 Then DataGrid1.AllowUpdate = False
    If 权限类别(2) = 0 Then
        退出入库单.Enabled = False
        删除入库单.Enabled = False
    End If
    If 权限类别(8) = 0 Then 打印入库单.Enabled = False
   
End Sub
Private Sub 打印入库单_Click()
    On Error GoTo quit
    Dim p As New 新增入库单
    p.编号 = DataGrid1.Columns(0).Value
    p.Show vbModal
   
    Unload p
   
quit:
End Sub
Private Sub 删除入库单_Click()
    On Error GoTo quit
    If DataGrid1.Columns(12).Text = "已退出" Then GoTo con
    If MsgBox("建议用[退出入库单],而不要直接删除,以免数据丢失.您确信要删除该入库单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
con:
   
    On Error Resume Next
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,入库数量,仓库编号 from 入库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("入库数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    ';如果是已退出入库单则直接删除
    If DataGrid1.Columns(12).Text = "已退出" Then
        If MsgBox("您确信要删除该入库退出单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
   
        fMainForm.m_checkado.RecordSource = "select * from 入库单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        Exit Sub
    End If
   
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    ';库存不足
    If num2 < num1 Then
        If MsgBox("库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "," + "要忽略它并强制删除吗?", vbQuestion Or vbYesNo) = vbNo Then Exit Sub
    End If
    ';更新库存状况
    If num2 - num1 > 0 Then
        fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
        fMainForm.m_checkado.Recordset.update
    Else ';如果库存为零清空
        fMainForm.m_checkado.Recordset.Delete
    End If
   
    fMainForm.m_checkado.Refresh
    ';更新入库单
    fMainForm.m_checkado.RecordSource = "select * from 入库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
    fMainForm.m_checkado.Recordset.Delete
    fMainForm.m_checkado.Refresh
        
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    MsgBox "入库单删除成功!"
    ';写入系统日志
    fMainForm.WriteLog ("删除入库单")
quit:
   
End Sub
Private Sub 退出入库单_Click()
    On Error GoTo quit
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
    If DataGrid1.Columns(12).Text = "已退出" Then
        MsgBox "该入库单已退出!"
        Exit Sub
    End If
   
    On Error Resume Next
    fMainForm.m_checkado.RecordSource = "select 货物编号,入库数量,仓库编号 from 入库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("入库数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    ';库存不足
    If num2 < num1 Then
        MsgBox "库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "."
        Exit Sub
    Else
    ';更新库存状况
        If num2 - num1 > 0 Then
            fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
            fMainForm.m_checkado.Recordset.update
        Else ';如果库存为零清空
            fMainForm.m_checkado.Recordset.Delete
        End If
        fMainForm.m_checkado.Refresh
    ';更新入库单
        fMainForm.m_checkado.RecordSource = "select * from 入库单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Fields("定单状况") = "已退出"
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        
        MsgBox "入库单退出成功!"
        ';写入系统日志
        fMainForm.WriteLog ("退出入库单")
    End If
   
quit:
End Sub

数据清除

Option Explicit
Private Sub CancelButton_Click()
    Unload Me
End Sub
Private Sub OKButton_Click()
    If MsgBox("建议您备份数据库,您备分数据库吗?", vbYesNo Or vbQuestion) = vbYes Then
         
         On Error GoTo failure
         
         With dlgCommonDialog
              .DialogTitle = "数据库备份为.."
              .ShowSave
        
              If Len(.filename) = 0 Then Exit Sub
              
              If BackupData(DataPath, .filename) = 1 Then
                  MsgBox "备份成功!"
              Else
failure:
                  MsgBox "备份失败!"
              End If
        End With
    Else
        If MsgBox("您确信要清除吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
    End If
   
    On Error Resume Next
    If 所有单据.Value = 1 Then
       ';删除入库单
        fMainForm.m_checkado.RecordSource = "select * from 入库单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
        
        ';删除出库单
        fMainForm.m_checkado.RecordSource = "select * from 出库单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
        
        ';删除借入单
        fMainForm.m_checkado.RecordSource = "select * from 借入单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
        
        ';删除借出单
        fMainForm.m_checkado.RecordSource = "select * from 借出单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
        
        ';删除调拔单
        fMainForm.m_checkado.RecordSource = "select * from 调拔单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
        
        ';删除报损单
        fMainForm.m_checkado.RecordSource = "select * from 报损单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 库存状况.Value = 1 Then
        ';删除库存状况
        fMainForm.m_checkado.RecordSource = "select * from 库存状况"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 盘点单据.Value = 1 Then
         ';删除盘点单
        fMainForm.m_checkado.RecordSource = "select * from 盘点单"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 客户信息.Value = 1 Then
        ';删除客户
        fMainForm.m_checkado.RecordSource = "select * from 客户"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 供应商信息.Value = 1 Then
         ';删除供应商
        fMainForm.m_checkado.RecordSource = "select * from 供应商"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 货物信息.Value = 1 Then
         ';删除货物信息
        fMainForm.m_checkado.RecordSource = "select * from 货物信息"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 货物类别.Value = 1 Then
         ';删除货物类别
        fMainForm.m_checkado.RecordSource = "select * from 货物类别"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 仓库信息.Value = 1 Then
         ';删除仓库
        fMainForm.m_checkado.RecordSource = "select * from 仓库"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 职员信息.Value = 1 Then
         ';删除职员信息
        fMainForm.m_checkado.RecordSource = "select * from 职员信息"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 公司信息.Value = 1 Then
        ';删除公司信息,不能删除，全部置空即可
        fMainForm.m_checkado.RecordSource = "select * from 公司信息"
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Fields("公司名称").Value = ""
        fMainForm.m_checkado.Recordset.Fields("地址").Value = ""
        fMainForm.m_checkado.Recordset.Fields("城市").Value = ""
        fMainForm.m_checkado.Recordset.Fields("省份").Value = ""
        fMainForm.m_checkado.Recordset.Fields("国家").Value = ""
        fMainForm.m_checkado.Recordset.Fields("邮政编码").Value = ""
        fMainForm.m_checkado.Recordset.Fields("电话号码").Value = ""
        fMainForm.m_checkado.Recordset.Fields("电子邮件").Value = ""
        fMainForm.m_checkado.Recordset.Fields("传真号码").Value = ""
        fMainForm.m_checkado.Recordset.Fields("开户银行").Value = ""
        fMainForm.m_checkado.Recordset.Fields("银行帐号").Value = ""
        fMainForm.m_checkado.Recordset.Fields("业务描述").Value = ""
        
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
    End If
   
    If 系统日志.Value = 1 Then
       ';删除系统日志
        fMainForm.m_checkado.RecordSource = "select * from 系统日志"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
    End If
   
    If 用户管理.Value = 1 Then
         ';删除用户管理
        fMainForm.m_checkado.RecordSource = "select * from 用户管理"
        fMainForm.m_checkado.Refresh
        DeleteRecordData fMainForm.m_checkado.Recordset
   
        ';增加一个管理员admin
        fMainForm.m_checkado.RecordSource = "select * from 用户管理"
        
        fMainForm.m_checkado.Recordset.AddNew
        fMainForm.m_checkado.Recordset.Fields("用户名") = "admin"
        fMainForm.m_checkado.Recordset.Fields("用户密码") = ""
        fMainForm.m_checkado.Recordset.Fields("用户权限") = 131071
        
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
        
        ';更改当前登陆用户信息
        UserName = "admin": UserPas = "": Purview = 131071
        Dim i As Integer
        For i = 0 To 16
            权限类别(i) = 1
        Next
        
    End If
   
    Unload Me
   
    MsgBox "数据清除成功!"
     ';写入系统日志
    fMainForm.WriteLog ("进行数据清除")
   
End Sub
Private Sub 仓库信息_Click()
   
    If 仓库信息.Value = 1 Then
        所有单据.Enabled = False
        盘点单据.Enabled = False
    Else
        所有单据.Enabled = True
        盘点单据.Enabled = False
    End If
   
    所有单据.Value = 1
    盘点单据.Value = 1
   
End Sub
Private Sub 供应商信息_Click()
   
    If 供应商信息.Value = 1 Then
        所有单据.Enabled = False
    Else
        所有单据.Enabled = True
    End If
   
    所有单据.Value = 1
            
End Sub
Private Sub 货物类别_Click()
   
    If 货物类别.Value = 1 Then
        所有单据.Enabled = False
        货物信息.Enabled = False
    Else
        所有单据.Enabled = True
        货物信息.Enabled = True
    End If
   
    所有单据.Value = 1
    货物信息.Value = 1
        
End Sub
Private Sub 货物信息_Click()
   
    If 货物信息.Value = 1 Then
        所有单据.Enabled = False
    Else
        所有单据.Enabled = True
    End If
   
    所有单据.Value = 1
   
End Sub
Private Sub 客户信息_Click()
   
    If 客户信息.Value = 1 Then
        所有单据.Enabled = False
    Else
        所有单据.Enabled = True
    End If
            
    所有单据.Value = 1
   
End Sub

Private Sub 用户管理_Click()
   
    If 用户管理.Value = 1 Then
        系统日志.Enabled = False
    Else
        系统日志.Enabled = True
    End If
            
    系统日志.Value = 1
   
End Sub
Private Sub 职员信息_Click()
    If 职员信息.Value = 1 Then
        所有单据.Enabled = False
        仓库信息.Enabled = False
        盘点单据.Enabled = False
    Else
        所有单据.Enabled = True
        仓库信息.Enabled = True
        盘点单据.Enabled = True
    End If
   
    所有单据.Value = 1
    仓库信息.Value = 1
    盘点单据.Value = 1
   
End Sub

数据选择 Public title As String Public result1 As String Public result2 As String Option Explicit Private Sub CancelButton_Click() result1 = "" result2 = "" Unload Me End Sub Private Sub Form_Load() Adodc1.Visible = False End Sub Private Sub Form_Resize() On Error Resume Next Adodc1.ConnectionString = DataConnectString Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Me.caption = title Dim d As Integer Dim inttype As Integer If DataGrid1.Columns.count <= 2 Then d = 600 Else d = 50 End If Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = Len(DataGrid1.Columns(i).caption) * d inttype = Adodc1.Recordset.Fields(i).Type Select Case inttype Case dbBoolean DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbByte DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbInteger DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbLong DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbCurrency DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbSingle DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 600 Case dbDouble DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 700 Case dbDate DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 800 Case dbText DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbLongBinary DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbMemo DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbGUID DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case Else DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 End Select Next End Sub Private Sub OKButton_Click() On Error Resume Next result1 = DataGrid1.Columns(0).Text result2 = DataGrid1.Columns(1).Text Unload Me End Sub

系统日志 Dim SQL As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 1000 DataGrid1.Columns(1).width = 1800 DataGrid1.Columns(2).width = 2200 End Sub Private Sub Check1_Click() update End Sub Private Sub Check2_Click() update End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Set DataGrid1.DataSource = Adodc1 Adodc1.Visible = False Option1.Value = True End Sub Private Sub Option1_Click() update End Sub Private Sub Option2_Click() update End Sub Private Sub Option3_Click() update End Sub Private Sub Option4_Click() update End Sub Private Sub update() On Error GoTo quit Dim s As String s = SQL + " where true" If Check1.Value = 1 And 用户名.Text <> "" Then s = s + " and 用户名 like ';%" + 用户名.Text + "%';" End If If Check2.Value = 1 And 操作内容.Text <> "" Then s = s + " and 操作内容 like ';%" + 操作内容.Text + "%';" End If Dim t As Date t = Date If Option1.Value = True Then ElseIf Option2.Value = True Then t = DateAdd("d", -3, t) ElseIf Option3.Value = True Then t = DateAdd("d", -7, t) End If If Option4.Value = False Then s = s + " and 操作时间>=" + "#" + Str(t) + " 0:0:0#" End If s = s + " order by 操作时间 desc" Adodc1.RecordSource = s Adodc1.Refresh initdatagrid1 quit: End Sub Private Sub 操作内容_Change() Check2.Value = 0 End Sub Private Sub 用户名_Change() Check1.Value = 0 End Sub

新增报损单 Private 客户编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 报损单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,报损单.报损时间,报损单.报损单价,货物信息.计量单位,报损单.报损数量,(报损单.报损单价*报损单.报损数量) as 金额,报损单.其它金额,仓库.仓库名称 as 存放仓库,报损单.备注 from 报损单,货物信息,职员信息,仓库 where 货物信息.编号=报损单.货物编号 and 职员信息.编号=报损单.经办人编号 and 仓库.编号=报损单.仓库编号 and 报损单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("报损单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("报损数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("报损时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写报损单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "报损失败,不能报损" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的报损单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,报损时间,报损单价,报损数量,仓库编号,其它金额,备注 from 报损单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("报损时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("报损单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("报损数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增报损单成功!" ';写入系统日志 fMainForm.WriteLog ("新增报损单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印报损单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择报损货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub