1234
返回列表 发帖

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
16楼 跳转到 »
漫天樱舞发表于 2005-5-15 21:33 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

调拔单

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
   
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 = 1000
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).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.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
    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
    Dim code As Long
    code = DataGrid1.Columns(0).Text
    If MsgBox("您确信要删除该调拔单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
    On Error Resume Next
    ';更新报损单
    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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
17楼
漫天樱舞发表于 2005-5-15 21:34 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

高级查询 Option Explicit Private pretext As String ';上一次sql语句 Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString Adodc1.Visible = False SQL.Text = "select * from " 表单.Text = "货物信息" SQL.SelStart = Len(SQL.Text) End Sub Private Sub Form_Resize() DataGrid1.width = Me.width - 440 DataGrid1.Height = Me.Height - Picture1.Height - 600 End Sub Private Sub 表单_GotFocus() 字段.Clear End Sub Private Sub 撤消字符_Click() SQL.Text = pretext End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "高级查询" End Sub Private Sub 添加表单字符_Click() pretext = SQL.Text SQL.Text = left$(SQL.Text, SQL.SelStart) + 表单.Text + Right$(SQL.Text, Len(SQL.Text) - SQL.SelStart) End Sub Private Sub 添加到自定义查询_Click() Dim f As New 自定义查询管理 f.SQL.Text = SQL.Text f.Show vbModal Unload f fMainForm.更新自定义查询菜单 End Sub Private Sub 添加字段字符_Click() pretext = SQL.Text SQL.Text = left$(SQL.Text, SQL.SelStart) + 字段.Text + Right$(SQL.Text, Len(SQL.Text) - SQL.SelStart) End Sub Private Sub 执行查询_Click() Dim s As String s = SQL.Text s = LCase(s) If s = "" Then MsgBox "请填写SQL语句!": Exit Sub If InStr(1, s, "update") <> 0 _ Or InStr(1, s, "delete") <> 0 _ Or InStr(1, s, "create") <> 0 _ Or InStr(1, s, "alter") <> 0 _ Or InStr(1, s, "drop") <> 0 _ Then MsgBox "SQL语句包含不安全的语句!": Exit Sub On Error Resume Next Adodc1.RecordSource = SQL.Text Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = Len(DataGrid1.Columns(i).caption) * 250 Next End Sub Private Sub 字段_GotFocus() If 表单.Text = "货物信息" Then 字段.AddItem "编号" 字段.AddItem "货物名称" 字段.AddItem "货物类别" 字段.AddItem "货物规格" 字段.AddItem "入库单价" 字段.AddItem "出库单价" 字段.AddItem "计量单位" 字段.AddItem "最低限量" 字段.AddItem "最高限量" 字段.AddItem "备注" ElseIf 表单.Text = "货物类别" Then 字段.AddItem "类别名称" 字段.AddItem "增值税" ElseIf 表单.Text = "职员信息" Then 字段.AddItem "编号" 字段.AddItem "姓名" 字段.AddItem "性别" 字段.AddItem "头衔" 字段.AddItem "电话号码" 字段.AddItem "手机" 字段.AddItem "通迅地址" 字段.AddItem "邮政编码" 字段.AddItem "备注" ElseIf 表单.Text = "公司信息" Then 字段.AddItem "编号" 字段.AddItem "公司名称" 字段.AddItem "地址" 字段.AddItem "城市" 字段.AddItem "省份" 字段.AddItem "邮政编码" 字段.AddItem "国家" 字段.AddItem "电话号码" 字段.AddItem "电子邮件" 字段.AddItem "传真号码" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "业务描述" ElseIf 表单.Text = "供应商" Then 字段.AddItem "编号" 字段.AddItem "供应商名称" 字段.AddItem "联系人姓名" 字段.AddItem "联系人职称" 字段.AddItem "地址" 字段.AddItem "城市" 字段.AddItem "邮政编码" 字段.AddItem "省份" 字段.AddItem "国家" 字段.AddItem "电话号码" 字段.AddItem "传真号码" 字段.AddItem "电子邮件" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "业务描述" ElseIf 表单.Text = "客户" Then 字段.AddItem "编号" 字段.AddItem "客户名称" 字段.AddItem "联系人" 字段.AddItem "电话号码" 字段.AddItem "手机" 字段.AddItem "传真号码" 字段.AddItem "通迅地址" 字段.AddItem "邮政编码" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "备注" ElseIf 表单.Text = "库存状况" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "库存数量" 字段.AddItem "仓库编号" ElseIf 表单.Text = "仓库" Then 字段.AddItem "编号" 字段.AddItem "仓库名称" 字段.AddItem "仓库地点" 字段.AddItem "保管员编号" 字段.AddItem "备注" ElseIf 表单.Text = "入库单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "入库时间" 字段.AddItem "入库单价" 字段.AddItem "计量单位" 字段.AddItem "入库数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "出库单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "出库时间" 字段.AddItem "出库单价" 字段.AddItem "出库数量" 字段.AddItem "金额" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "借入单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "借入时间" 字段.AddItem "借入单价" 字段.AddItem "借入数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "借出单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "借出时间" 字段.AddItem "借出单价" 字段.AddItem "借出数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "调拔单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "调拔时间" 字段.AddItem "调拔单价" 字段.AddItem "调拔数量" 字段.AddItem "原仓库编号" 字段.AddItem "目标仓库编号" 字段.AddItem "备注" ElseIf 表单.Text = "报损单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "入库时间" 字段.AddItem "报损数量" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "盘点单" Then 字段.AddItem "编号" 字段.AddItem "仓库编号" 字段.AddItem "经办人编号" 字段.AddItem "盘点时间" ElseIf 表单.Text = "用户管理" Then 字段.AddItem "编号" 字段.AddItem "用户名" 字段.AddItem "用户密码" 字段.AddItem "用户权限" ElseIf 表单.Text = "系统日志" Then 字段.AddItem "编号" 字段.AddItem "用户名" 字段.AddItem "操作时间" 字段.AddItem "操作内容" End If End Sub

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
18楼
漫天樱舞发表于 2005-5-15 21:36 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

公司信息

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
19楼
漫天樱舞发表于 2005-5-15 21:36 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

供应商
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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
20楼
漫天樱舞发表于 2005-5-15 21:37 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

货物出入统计

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
21楼
漫天樱舞发表于 2005-5-15 21:38 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

货物信息

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
22楼
漫天樱舞发表于 2005-5-15 21:39 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

借出单

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
23楼
漫天樱舞发表于 2005-5-15 21:41 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

借入单

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
24楼
漫天樱舞发表于 2005-5-15 21:41 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

客户

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
25楼
漫天樱舞发表于 2005-5-15 21:43 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

库存查询 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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
26楼
漫天樱舞发表于 2005-5-15 21:44 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

库存状况 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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
27楼
漫天樱舞发表于 2005-5-15 21:44 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

权限选择

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
28楼
漫天樱舞发表于 2005-5-15 21:45 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

入库单

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
29楼
漫天樱舞发表于 2005-5-15 21:46 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

数据清除

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

TOP

主题
0 
积分
0 
贝壳
0 个 
来自
云南曲靖 
注册时间
2006-11-19 
最后登录
2006-11-19 
30楼
漫天樱舞发表于 2005-5-15 21:47 | 只看该作者

[公告]技术区5.1比赛作品发表专帖

数据选择 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

TOP

1234
返回列表 回复 发帖