module2.bas

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

Attribute VB_Name = "Module2"

Public Dbname As String '设置全局变量，存储当前打开的数据库名称
Dim dbworkspace As Workspace
Dim db As Database
Dim Intb As Recordset
Dim Numtb As Recordset
Dim outtbpf As Recordset
Dim outtbls As Recordset

'打开帐薄的过程
Sub OpenZhangBu(zhangbu As String)
MainForm.mnufileclose.Enabled = True
MainForm.mnufilebackup.Enabled = True
MainForm.mnuworkin.Enabled = True
MainForm.mnuworklookup.Enabled = True
MainForm.mnuworkout.Enabled = True
MainForm.mnuworkprint.Enabled = True
MainForm.Toolbar1.Buttons(5).Enabled = True
MainForm.Toolbar1.Buttons(7).Enabled = True
MainForm.Toolbar1.Buttons(10).Enabled = True
MainForm.Toolbar1.Buttons(11).Enabled = True
MainForm.Toolbar1.Buttons(15).Enabled = True
On Error Resume Next
Dim zbname As String
zbname = zhangbu
'Set dbworkspace = DBEngine.CreateWorkspace("inws", "admin", "", dbUseJet)
Set dbworkspace = DBEngine.Workspaces(0)
'Set db = dbworkspace.OpenDatabase(zbname, False, False, ";pwd=1271703468")
Set db = dbworkspace.OpenDatabase(zbname, False, False)
Set Intb = db.OpenRecordset("intable")
Set Numtb = db.OpenRecordset("numtable")
Set outtbpf = db.OpenRecordset("outtablepifa")
Set outtbls = db.OpenRecordset("outtablellingshou")
Ioform.Show
Set Ioform.DataIntb.Recordset = Intb
Set Ioform.DataOuttbpf.Recordset = outtbpf
Set Ioform.DataOuttbls.Recordset = outtbls
End Sub
'获取数据库名
Function GetDbName()
'设置打开对话框的默认扩展名
MainForm.CommonDialog1.DefaultExt = "mdb"
'设置文件过滤器
MainForm.CommonDialog1.Filter = "Database files(*.mdb)|*.mdb|All file(*.*)|*.*"
'设置文件的初始路径
Dim dbpath As String
dbpath = App.Path + "\" + "data"
MainForm.CommonDialog1.InitDir = dbpath
MainForm.CommonDialog1.CancelError = True
On Error GoTo errline '显示打开对话框
MainForm.CommonDialog1.ShowOpen
'获取文件名，并把文件名保存到全局变量Dbname中
Dbname = MainForm.CommonDialog1.FileTitle
Dim nm As String
nm = MainForm.CommonDialog1.filename
GetDbName = nm
errline:
Exit Function
End Function
'这里是新建帐薄的过程
Sub NewZhangBu()
'设置打开对话框的默认扩展名
MainForm.CommonDialog1.DefaultExt = "mdb"
'设置文件过滤器
MainForm.CommonDialog1.Filter = "Database files(*.mdb)|*.mdb"
'设置初始文件的路径
Dim dbpath As String
dbpath = App.Path + "\" + "data"
MainForm.CommonDialog1.InitDir = dbpath
MainForm.CommonDialog1.Flags = cdlOFNOverwritePrompt
MainForm.CommonDialog1.CancelError = True
On Error GoTo errline
'显示保存对话框
MainForm.CommonDialog1.ShowSave
If MainForm.CommonDialog1.filename <> "" Then
'复制数据库模板
Dim sourcepathname As String
sourcepathname = App.Path + "\" + "source" + "\" + "database.mdb"
FileCopy sourcepathname, MainForm.CommonDialog1.filename
'MsgBox "在这里添加打开当前数据库的代码"
OpenZhangBu (MainForm.CommonDialog1.filename)
Dbname = MainForm.CommonDialog1.FileTitle
Else
MsgBox "帐薄建立失败"
End If
errline:
Exit Sub
End Sub
'备份数据库的过程
Sub DataBackup()
On Error Resume Next
'设置备份文件的名称
Dim dm As String
dm = Dbname
 '设置备份目录
Dim backuppathname As String
backuppathname = App.Path + "\" + "BackUp" + "\" + dm
If Dbname <> "" And backuppathname <> "" Then
'关闭帐薄
db.Close
dbworkspace.Close
'复制帐薄
FileCopy Dbname, backuppathname
'重新打开帐薄
OpenZhangBu (Dbname)
End If
End Sub
Sub DataRestore()
'MsgBox "这里是数据库还原的代码"
'设置打开对话框的默认扩展名
MainForm.CommonDialog1.DefaultExt = "mdb"
'设置文件过滤器
MainForm.CommonDialog1.Filter = "Database files(*.mdb)|*.mdb"
'设置初始文件的路径
Dim dbpath As String
dbpath = App.Path + "\" + "BackUp"
MainForm.CommonDialog1.InitDir = dbpath
MainForm.CommonDialog1.DialogTitle = "还原"
On Error GoTo errline
'显示保存对话框
MainForm.CommonDialog1.ShowOpen
If MainForm.CommonDialog1.filename <> "" Then
Dim sourcepathname As String
sourcepathname = MainForm.CommonDialog1.filename
Dim destinationpathname As String
destinationpathname = App.Path + "\" + "Data" + "\" + MainForm.CommonDialog1.FileTitle
'关闭帐薄
If Dbname <> "" Then
db.Close
dbworkspace.Close
End If
'复制帐薄
FileCopy sourcepathname, destinationpathname
'打开新帐薄
OpenZhangBu (destinationpathname)
End If
errline:
Exit Sub
End Sub

'关闭当前数据库
Sub CloseDatabase()
On Error Resume Next
Unload Ioform
Ioform.Hide
MainForm.mnufileclose.Enabled = False
Ioform.SSTab1.Tab = 0
MainForm.mnufilebackup.Enabled = False
MainForm.mnuworkin.Enabled = False
MainForm.mnuworklookup.Enabled = False
MainForm.mnuworkout.Enabled = False
MainForm.mnuworkprint.Enabled = False
MainForm.Toolbar1.Buttons(5).Enabled = False
MainForm.Toolbar1.Buttons(7).Enabled = False
MainForm.Toolbar1.Buttons(10).Enabled = False
MainForm.Toolbar1.Buttons(11).Enabled = False
MainForm.Toolbar1.Buttons(15).Enabled = False

End Sub

'这里是添加的代码
Sub AddDataIntb()
On Error Resume Next
Ioform.DataIntb.Recordset.AddNew
'对各个字段进行付值
Ioform.DataIntb.Recordset.fields(0) = AddForm.DBComboHuowuming.Text '货物名称
Ioform.DataIntb.Recordset.fields(1) = Val(AddForm.TextDanjia.Text) '单价
Ioform.DataIntb.Recordset.fields(2) = Val(AddForm.TextShuliang.Text) '货物数量
Ioform.DataIntb.Recordset.fields(3) = Val(AddForm.TextYingFuKuan.Text) '应付款
Ioform.DataIntb.Recordset.fields(4) = Val(AddForm.TextShiFuKuan.Text) '实付款
Ioform.DataIntb.Recordset.fields(5) = Val(AddForm.TextJiesuan.Text) '结算
Ioform.DataIntb.Recordset.fields(6) = AddForm.ComboFuZeRen.Text '负责人
Ioform.DataIntb.Recordset.fields(7) = AddForm.ComboHuoYuanDanWei.Text '货源单位
Ioform.DataIntb.Recordset.fields(8) = AddForm.TextDate.Text '进货日期
Ioform.DataIntb.Recordset.fields(9) = AddForm.TextTime.Text '进货时间
Ioform.DataIntb.Recordset.fields(10) = AddForm.TextCaozuoyuan.Text '操作员
If AddForm.TextBeiZhu.Text <> "" Then
Ioform.DataIntb.Recordset.fields(11) = AddForm.TextBeiZhu.Text '备注
End If
Ioform.DataIntb.Recordset.Update
'初始化各个字段
AddForm.DBComboHuowuming.Text = ""
AddForm.TextDanjia.Text = ""
AddForm.TextShuliang.Text = ""
AddForm.TextYingFuKuan.Text = ""
AddForm.TextShiFuKuan.Text = ""
AddForm.TextJiesuan.Text = ""
AddForm.ComboFuZeRen.Text = ""
AddForm.ComboHuoYuanDanWei.Text = ""
AddForm.TextBeiZhu.Text = ""
End Sub

Sub DelDataIntb()
On Error Resume Next
'MsgBox "在这里添加删除的代码"
If MsgBox("真的要删除这条记录吗？", vbYesNo, "提示") = vbYes Then
Ioform.DataIntb.Recordset.Delete
End If
End Sub
Sub InitAddform()
On Error Resume Next
Set AddForm.DataHuowuming.Recordset = Numtb
AddForm.DBComboHuowuming.ListField = "货物名称"
AddForm.TextCaozuoyuan.Text = Module1.UserName
End Sub
'向货物名数据库添加数据
Sub AddDataNumtb()
On Error Resume Next
'设置索引
Numtb.Index = "货物名称"
Numtb.Seek "=", AddForm.DBComboHuowuming.Text
'如果没找到就添加新记录
If Numtb.NoMatch Then
Numtb.AddNew
Numtb.fields(0) = AddForm.DBComboHuowuming.Text
Numtb.fields(1) = Val(AddForm.TextShuliang.Text)
Numtb.Update
Else
'把数量相加后保存
Numtb.Edit
Numtb.fields(1) = Numtb.fields(1).Value + Val(AddForm.TextShuliang.Text)
Numtb.Update
End If
'errline:
'MsgBox "向货物数据库中添加数据时发生错误", vbInformation + vbOKOnly, "错误"
'Exit Sub
End Sub

'初始化outform的控件数据
Sub InitOutform()
On Error Resume Next
'将货物名数据库绑定到outform的datacombhuowuming上
Set Outform.DataHuowuming.Recordset = Numtb
Outform.DBComboHuowuming.ListField = "货物名称"
Outform.TextCaozuoyuan.Text = Module1.UserName
End Sub

'这里是售出货物的过程
Sub SellHuowu()
On Error Resume Next
'如果选项是批发则把数据添加到批发表中
If Outform.Option(0).Value = True Then
outtbpf.AddNew
outtbpf.fields(0) = Outform.DBComboHuowuming.Text '货物名
outtbpf.fields(1) = Val(Outform.TextShuliang.Text) '货物数量
outtbpf.fields(2) = Val(Outform.TextDanjia.Text) '单价
outtbpf.fields(3) = Val(Outform.TextYingshoukuan.Text) '应收款
outtbpf.fields(4) = Val(Outform.TextShishoukuan.Text) '实收款
outtbpf.fields(5) = Val(Outform.TextJiesuan.Text) '结算
outtbpf.fields(6) = Outform.TextJingshouren.Text '负责人
outtbpf.fields(7) = Outform.ComboMaifangdanwei.Text '买方单位
outtbpf.fields(8) = Outform.TextDate.Text '销售日期
outtbpf.fields(9) = Outform.TextTime.Text '销售时间
outtbpf.fields(10) = Outform.TextCaozuoyuan.Text '操作员
    If Outform.TextBeiZhu.Text <> "" Then
    outtbpf.fields(11) = Outform.TextBeiZhu.Text '备注
    End If
outtbpf.Update
End If
'如果选项是零售则把数据添加到零售表中
If Outform.Option(1).Value = True Then
outtbls.AddNew
outtbls.fields(0) = Outform.DBComboHuowuming.Text '货物名
outtbls.fields(1) = Val(Outform.TextShuliang.Text) '货物数量
outtbls.fields(2) = Val(Outform.TextDanjia.Text) '单价
outtbls.fields(3) = Val(Outform.TextJiesuan.Text) '结算
outtbls.fields(4) = Outform.TextDate.Text '销售日期
outtbls.fields(5) = Outform.TextTime.Text '销售时间
outtbls.fields(6) = Outform.TextCaozuoyuan.Text '操作员
outtbls.Update
End If
'把数据记录到货物名表中去
Numtb.Edit