module2.bas

上学时写的一个进销存管理软件

Numtb.fields(1) = Numtb.fields(1) - Val(Outform.TextShuliang)
Numtb.Update
'初始化窗体中的各个控件
Outform.TextShuliang.Text = ""
Outform.TextDanjia.Text = ""
Outform.TextYingshoukuan.Text = ""
Outform.TextShishoukuan.Text = ""
Outform.TextJiesuan.Text = ""
Outform.ComboMaifangdanwei.Text = ""
Outform.TextJingshouren.Text = ""
Outform.TextBeiZhu.Text = ""
End Sub
'这里是删除出货记录的过程
Sub DelSellHuowu(ByRef tb As String)
On Error Resume Next
'先向货物名表中恢复删除数据
'根据当前控件的焦点来决定删除哪一个库的记录
If tb <> pf Or tb <> ls Then
MsgBox "请选择一个表"
Exit Sub
End If
Select Case tb
Case pf
If MsgBox("真的要删除批发表的这条记录吗？", vbYesNo, "提示") = vbYes Then
Numtb.Index = "货物名称"
Numtb.Seek "=", Ioform.DataOuttbpf.Recordset.fields(0)
Numtb.Edit
Numtb.fields(1) = Numtb.fields(1) + Ioform.DataOuttbpf.Recordset.fields(1)
Ioform.DataOuttbpf.Recordset.Delete
Numtb.Update
End If
Case ls
If MsgBox("真的要删除零售表的这条记录吗？", vbYesNo, "提示") = vbYes Then
Numtb.Index = "货物名称"
Numtb.Seek "=", Ioform.DataOuttbls.Recordset.fields(0)
Numtb.Edit
Numtb.fields(1) = Numtb.fields(1) + Ioform.DataOuttbls.Recordset.fields(1)
Ioform.DataOuttbls.Recordset.Delete
Numtb.Update
End If
End Select
End Sub

'初始化查询窗体
Sub InitSeachform()
On Error Resume Next
SeachForm.DTPicker1.Value = Date
SeachForm.DTPicker2.Value = Date
Set SeachForm.DataHuowuming.Recordset = Numtb
SeachForm.DBComboHuowuming.ListField = "货物名称"
Module1.InitSeachformCaozuoyuan
If SeachForm.ComboTable.Text = "" Then
SeachForm.DBComboHuowuming.Enabled = False
SeachForm.TextFuzeren.Enabled = False
SeachForm.TextDanwei.Enabled = False
SeachForm.Check1.Enabled = False
SeachForm.DBComboCaozuoyuan.Enabled = False
SeachForm.Command1.Enabled = False
End If
End Sub

'执行查询
Sub StartSeach()
On Error Resume Next
selectsql = ""

If SeachForm.DBComboHuowuming.Text <> "" Then
selectsql = selectsql & " and 货物名称 = '" & SeachForm.DBComboHuowuming.Text & "' "
End If

If SeachForm.TextFuzeren.Text <> "" Then
selectsql = selectsql & " and 负责人 = '" & SeachForm.TextFuzeren.Text & "' "
End If

If SeachForm.TextDanwei.Text <> "" Then
    If SeachForm.ComboTable.Text = "进货表" Then
    selectsql = selectsql & " and 货源单位 = '" & SeachForm.TextDanwei.Text & "' "
    Else
        If SeachForm.ComboTable.Text = "批发表" Then
        selectsql = selectsql & " and 买方单位 = '" & SeachForm.TextDanwei.Text & "' "
        End If
    End If
End If

If SeachForm.Check1.Value = 1 Then
    If SeachForm.DTPicker1.Value > SeachForm.DTPicker2.Value Then
    mgx = MsgBox("表达式错误", vbInformation + vbOKOnly, "错误")
    Else
        If SeachForm.ComboTable.Text = "进货表" Then
            If SeachForm.DTPicker1.Value = SeachForm.DTPicker2.Value Then
            selectsql = selectsql & " and 进货日期 = #" & SeachForm.DTPicker1.Value & "# "
            Else
                If SeachForm.DTPicker1.Value < SeachForm.DTPicker2.Value Then
                selectsql = selectsql & " and 进货日期 >= #" & SeachForm.DTPicker1.Value & "# "
                selectsql = selectsql & " and 进货日期 <= #" & SeachForm.DTPicker2.Value & "# "
                End If
            End If
        Else
            If SeachForm.ComboTable.Text = "批发表" Then
                If SeachForm.DTPicker1.Value = SeachForm.DTPicker2.Value Then
                selectsql = selectsql & " and 销售日期 = #" & SeachForm.DTPicker1.Value & "# "
                Else
                    If SeachForm.DTPicker1.Value < SeachForm.DTPicker2.Value Then
                    selectsql = selectsql & " and 销售日期 >= #" & SeachForm.DTPicker1.Value & "# "
                    selectsql = selectsql & " and 销售日期 <= #" & SeachForm.DTPicker2.Value & "# "
                    End If
                End If
            End If
        End If
    End If
End If

If SeachForm.DBComboCaozuoyuan.Text <> "" Then
selectsql = selectsql & " and 操作员 = '" & SeachForm.DBComboCaozuoyuan.Text & "' "
End If

If selectsql <> "" Then
    If SeachForm.ComboTable.Text = "进货表" Then
    seachtb = "intable"
    End If
    
    If SeachForm.ComboTable.Text = "批发表" Then
    seachtb = "outtablepifa"
    End If
    
    If SeachForm.ComboTable.Text = "零售表" Then
    seachtb = "outtablellingshou"
    End If
    
    Ioform.DataResult.DatabaseName = Module2.Dbname
    Ioform.DataResult.RecordSource = "SELECT * FROM " & Trim(seachtb) & " WHERE 货物名称 <> '' " & selectsql
    'On Error Resume Next
    Ioform.DataResult.Refresh
End If
Unload SeachForm
'errline:
'MsgBox "查询时发生错误", vbInformation + vbOKOnly, "错误"
'Exit Sub
End Sub

Sub Initformhuowumanger()
On Error Resume Next
With FormHuowumanger
Set .data1.Recordset = Numtb
'初始化用户管理的窗体
.Text1.Text = .data1.Recordset.fields(0)
.Text2.Text = .data1.Recordset.fields(1)
.Text1.Enabled = False
.Text2.Enabled = False
.Command(6).Enabled = False
.data1.Recordset.MoveFirst
End With
End Sub

Sub HuoWuManger(ByRef idx As Integer)
On Error Resume Next
With FormHuowumanger
Select Case idx
Case 1
'MsgBox "这里是前一个的代码"
.data1.Recordset.MovePrevious
.Command(2).Enabled = True
.Text1.Enabled = False
.Text2.Enabled = False
If Numtb.BOF Then
Numtb.MoveNext
.Command(1).Enabled = False
Else
.Text1.Text = Numtb.fields(0)
.Text2.Text = Numtb.fields(1)
End If
Case 2
'MsgBox "这里是下一个的代码"
.data1.Recordset.MoveNext
.Command(1).Enabled = True
.Text1.Enabled = False
.Text2.Enabled = False
If Numtb.EOF Then
Numtb.MovePrevious
.Command(2).Enabled = False
Else
.Text1.Text = Numtb.fields(0)
.Text2.Text = Numtb.fields(1)
End If
Case 3
'MsgBox "这里是添加的代码"
Numtb.AddNew
.Text1.Text = ""
.Text2.Text = ""
.Text1.Enabled = True
.Text2.Enabled = True
.Command(4).Enabled = False
.Command(5).Enabled = False
Case 4
'MsgBox "这里是删除的代码"
If MsgBox("真的要删除吗？", vbQuestion + vbOKCancel, "提示") = vbOK Then
Numtb.Delete
If Numtb.EOF = False Then
Numtb.MoveNext
Else
Numtb.MovePrevious
.Text1.Text = Numtb.fields(0)
.Text2.Text = Numtb.fields(1)
End If
End If
Case 5
'MsgBox "这里时编辑的代码"
Numtb.Edit
.Text1.Enabled = True
.Text2.Enabled = True
Case 6
'MsgBox "这里是更新的代码"
If .Text1.Text = "" Then
MsgBox "用户名不能为空"
.Command(6).Enabled = True
Else
    Numtb.fields(0) = .Text1.Text
    Numtb.fields(1) = Val(.Text2.Text)
    Numtb.Update
    Numtb.MoveFirst
    .Command(6).Enabled = False
    .Text1.Enabled = False
    .Text2.Enabled = False
End If
.Command(4).Enabled = True
.Command(5).Enabled = True
End Select
End With
End Sub

Sub ZhangBuPrint(Printreport As Integer)
On Error Resume Next
'MsgBox "这里是打印报表的过程"
'设置临时文件的名称
Dim dm As String
dm = Dbname
 '设置备份目录
Dim temppathname As String
temppathname = App.Path + "\" + "Temp" + "\" + dm
If Dbname <> "" And temppathname <> "" Then
'关闭帐薄
db.Close
dbworkspace.Close
'复制帐薄
FileCopy Dbname, temppathname
'重新打开帐薄
OpenZhangBu (Dbname)
End If
'调用Access打印报表
Dim MSAccess As Access.Application
Set MSAccess = New Access.Application
If Dbname <> "" Then
MSAccess.OpenCurrentDatabase (temppathname)
Select Case Printreport
Case 0
MSAccess.DoCmd.OpenReport "进货报表", acViewNormal
Case 1
MSAccess.DoCmd.OpenReport "库存货物报表", acViewNormal
Case 2
MSAccess.DoCmd.OpenReport "批发货物报表", acViewNormal
Case 3
MSAccess.DoCmd.OpenReport "零售货物报表", acViewNormal
End Select
MSAccess.CloseCurrentDatabase
Set MSAccess = Nothing
End If
Kill temppathname
'errline:
'MsgBox "报表打印错误", vbInformation + vbOKOnly, "错误"
'Exit Sub
End Sub