资源目录
压缩包内文档预览:(预览前20页/共42页)
编号:149910457
类型:共享资源
大小:4.03MB
格式:RAR
上传时间:2021-10-10
上传人:好资料QQ****51605
认证信息
个人认证
孙**(实名认证)
江苏
IP属地:江苏
20
积分
- 关 键 词:
-
vb
电表
管理
系统
源代码
论文
- 资源描述:
-
vb电表管理系统(源代码+论文),vb,电表,管理,系统,源代码,论文
- 内容简介:
-
毕业设计电表管理系统班级_姓名_学号_摘 要1Abstract2第一章 引言411 课题背景412 系统简介5第二章 系统的分析621 系统开发的目标和思想622 系统的可行性分析8第三章 系统的设计1831 系统的功能结构设计1832 系统的数据库设计33 界面设计与代码设计2324结束语46致谢47参考文献48摘 要 传统的电费管理都是由工作人员手工查表,抄表完成的,其中要完成用户电费的收取,每月抄度,用户购电情况查询,以及列出欠费用户的信息名单,之类的信息.其工作强度大,工作流程繁琐,由于工作人员的不细心,将会造成电费收支的出错也是经常发生的.鉴于以上原因我们有必要开发一种帮作电费管理人员的软件系统,可以完成检查用户用电情况,每月抄度,信息录入以及基本数据维护的各项功能.本系统采用visual basic 6.0与微软Access数据库方式.界面尽量做到人性化,数据维护方面做到可靠安全.关键字: 电费管理,visual basic, Access,数据库AbstractElectricity from the traditional management staff are artisanal Chabiao, meter reading completed, which should be completed by the users of electricity per month penalty for users to buy electricity enquiries, and a list of user information channels list such information. Its work-intensive, cumbersome workflow, because staff are not careful. would result in the tariff revenue is recurring mistakes. Given the above reasons we need to develop a management software to help make electricity system, the user can complete the inspection of electricity monthly copied degrees, Information includes basic data and the maintenance function. with the system using visual basic Microsoft Access 6.0 database. as far as possible humanization interface, data maintenance to reliable security. keyword : tariff management, visual basic, Access, the database第一章 引言11 课题背景传统的电费管理都是由工作人员手工查表,抄表完成的,其中要完成用户电费的收取,每月抄度,用户购电情况查询,以及列出欠费用户的信息名单,之类的信息.其工作强度大,工作流程繁琐,由于工作人员的不细心,将会造成电费收支的出错也是经常发生的.鉴于以上原因我们有必要开发一种帮作电费管理人员的软件系统,可以完成检查用户用电情况,每月抄度,信息录入以及基本数据维护的各项功能.本系统采用visual basic 6.0与微软Access数据库方式.界面尽量做到人性化,数据维护方面做到可靠安全.12 系统简介 本系统主要由以下几大功能模块组成:一. 用户交费:(交纳电费,本日小节)二. 本月抄度:(单户抄度 多户抄度)三. 资料导出 (全部清单,欠费清单)四. 数据查询 (电费查询与统计,用户欠费查询)五. 信息录入 (资料录入,资料修改, 资料删除)六. 系统数据维护 (数据备份,数据恢复)七. 基本数据维护 (用户类型维护, 操作员维护)八. 帮助九. 退出第二章 系统的分析21 系统开发的目标和思想 本系统主要服务于电费管理人员的日常工作.设计思路主要参照工作人员抄表,记录资料,资料管理,信息录入等方面的工作流程展开的.22 系统的可行性分析本系统采用visual basic6.0与微软的access作为数据库结合.在系统编写上具有可行性.经济方面:本系统可以服务电厂,电费管理单位,为企业节省人力开支.社会方面:服务于大众,方便抄表人员工作,可靠方便.第三章 系统的设计31 系统的功能结构设计程序登陆主界面用户交费本月抄费资料导出数据查询信息录入系统数据维护基本数据维护帮助退出32 系统的数据库设计1. 用户类型表:字段名称数据类型说明ATypeID自动编号AType文本电费类型UNITPRICE货币Adate日期/时间电费设置日期2. 密码表: 字段名称数据类型姓名文本操作权限文本密码文本3. MaxID表:字段名称数据说明TableName文本MaxID数字33 界面设计与代码设计1.用户登陆界面设计:34 界面设计与代码设计用户登陆界面代码分析:Private Sub Command1_Click()Dim rstpchard As New ADODB.RecordsetDim reHard As StringDim getid As StringreHard = GetpcHard(getid)rstpchard.Open select * from getpchard , gCnn, adOpenKeyset, adLockBatchOptimisticIf rstpchard.RecordCount = 0 Then rstpchard.AddNew rstpchard.Fields(0) = reHard rstpchard.UpdateBatch adAffectCurrentElse If Trim(reHard) Trim(rstpchard.Fields(0) Then MsgBox 对不起,使用不合法请与开发者联系! , vbInformation End End IfEnd IfIf Check1.Value = 1 ThenSet rec = New ADODB.Recordsetrec.Open select * from 记住密码, gCnn, 3, 3rec(标记) = 1If Combo2.Text Thenrec(姓名) = Combo2.TextElserec(姓名) = End IfIf Combo1.Text Thenrec(权限) = Combo1.TextElserec(权限) = End IfIf Text2.Text Thenrec(密码) = Text2.TextElserec(密码) = End Ifrec.Updaterec.CloseElseSet rec = New ADODB.Recordsetrec.Open select * from 记住密码, gCnn, 3, 3rec(标记) = 0rec.Updaterec.CloseEnd IfDim rec1 As ADODB.RecordsetSet rec1 = New ADODB.Recordsetrec1.Open select * from 登录人员, gCnn, 3, 3Set rec = New ADODB.Recordsetrec.Open select * from 密码表 where 姓名= & Combo2.Text & and 操作权限= & Combo1.Text & and 密码= & Text2.Text & , gCnn, 3, 3If rec.EOF = False Then If rec(操作权限) 管理员 Then FRMMAIN.XZCK.Enabled = False MDIme.mczy.Enabled = False MDIme.xtwh.Enabled = False MDIme.del.Enabled = False FRMMAIN.DJGL.Enabled = False FRMMAIN.delte.Enabled = False Else Me.XZCK.Enabled = True MDIme.mczy.Enabled = True MDIme.xtwh.Enabled = True CreateNewKey HKEY_CURRENT_USER, ZhiYuanTechnologe SetKeyValue HKEY_CURRENT_USER, ZhiYuanTechnologe, UserName, dlj, REG_SZ SetKeyValue HKEY_CURRENT_USER, ZhiYuanTechnologe, PassWord, dlj, REG_SZ FRMMAIN.DJGL.Enabled = True FRMMAIN.delte.Enabled = True End If rec1(姓名) = Combo2.Text rec1.Update rec1.Close Me.Hide Guser = Combo2.Text MDIme.ShowElse MsgBox 权限或密码不正确,请重试!, vbInformationEnd Ifrec.CloseEnd SubPrivate Sub Command11_Click()End SubPrivate Sub Command2_Click()Combo2.Text = Text2.Text = Combo1.Text = End Sub Private Sub Command3_Click()EndEnd SubPrivate Sub Command4_Click()Me.HideFRMMMXG.Show 1End Sub Private Sub Form_Activate()Text2.Text = Combo1.Text = Combo2.Text = Set rec = New ADODB.Recordsetrec.Open select * from 记住密码, gCnn, 3, 3If rec(标记) = 0 Or rec(标记) = 1 ThenCheck1.Value = rec(标记)End Ifrec.CloseSet rec = New ADODB.Recordsetrec.Open select * from 记住密码, gCnn, 3, 3If rec(标记) = 1 ThenCombo2.Text = rec(姓名)Combo1.Text = rec(权限)Text2.Text = rec(密码)End Ifrec.CloseCommand1.SetFocusEnd SubPrivate Sub Form_Load()gCnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _App.Path & datadbdb.mdb;Persist Security Info=FalsegCnn.CursorLocation = adUseClientgCnn.OpenSet rec = New ADODB.Recordsetrec.Open select distinct 姓名 from 密码表, gCnn, 3, 3With Combo2Do Until rec.EOF.AddItem rec(姓名)rec.MoveNextLoopEnd Withrec.CloseSet rec = NothingEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)Cancel = TrueSelect Case MsgBox(此操作将退出本系统,继续吗?, vbYesNo, 警告)Case vbYesCancel = FalseEndCase ElseCancel = TrueEnd SelectEnd Sub2.主界面设计:主界面代码设计:Private Sub alllm_Click()frmList.qfFlg = FalsefrmList.ShowEnd SubPrivate Sub backup_Click() frmbeifen.ShowEnd SubPrivate Sub benrixiaojie_Click()frmCount.ShowEnd SubPrivate Sub Command1_Click()frameFee.Visible = FalseEnd SubPrivate Sub cmdQuery_Click() Dim rst As New ADODB.Recordset rst.Open select * from panelinfo where holder= & Me.txtUser & and delflagtrue , gCnn, adOpenStatic, adLockBatchOptimistic If rst.RecordCount 0 Then dcvalue.Text = rst.Fields(2) txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields!nowecount txtUserName(2) = rst.Fields!cendcode dtpwdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields!lMoney, #0.00) txtUserName(4) = Format(rst.Fields!bmoney, #0.00) txtUserName(6) = Format(rst.Fields!lsFee, #0.00) txtUserName(5) = txtUserName(1) * rst.Fields!lMoney * (rst.Fields!lightScale / 100) + txtUserName(1) * txtUserName(4) * (1 - rst.Fields!lightScale / 100) txtUserName(5) = Format(txtUserName(1) * rst.Fields!lMoney * (rst.Fields!lightScale / 100) + rst.Fields!nowecount * rst.Fields!bmoney * (1 - rst.Fields!lightScale / 100), #0.00) txtUserName(8) = rst.Fields(9) txtUserName(7) = Format(Val(txtUserName(5) + Val(txtUserName(6), #0.00) dcNum.Text = rst.Fields(1) Else MsgBox 没有查询到数据! , vbInformation End If rst.Close Set rst = NothingEnd SubPrivate Sub dcNum_Click(Area As Integer) Dim rst As New ADODB.Recordset rst.Open select * from panelinfo where holderid= & dcNum.Text & and delflagtrue , gCnn, adOpenKeyset, adLockBatchOptimistic If Not rst.EOF Then dcvalue.Text = rst.Fields(2) txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields!nowecount txtUserName(2) = rst.Fields!cendcode dtpwdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields!lMoney, #0.00) txtUserName(4) = Format(rst.Fields!bmoney, #0.00) txtUserName(6) = Format(rst.Fields(8), #0.00) txtUserName(5) = Format(txtUserName(1) * txtUserName(3) * (rst.Fields!lightScale / 100) + txtUserName(1) * txtUserName(4) * (1 - rst.Fields!lightScale / 100), #0.00) txtUserName(8) = rst.Fields(9) txtUserName(7) = Format(Val(txtUserName(5) + Val(txtUserName(6), #0.00) End If rst.CloseEnd SubPrivate Sub dcvalue_Click(Area As Integer) Dim rst As New ADODB.Recordset rst.Open select * from panelinfo where holderid= & dcvalue.BoundText & and delflagtrue , gCnn, adOpenStatic, adLockBatchOptimistic If Not rst.EOF Then dcvalue.Text = rst.Fields(2) txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields!nowecount txtUserName(2) = rst.Fields!cendcode dtpwdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields!lMoney, #0.00) txtUserName(4) = Format(rst.Fields!bmoney, #0.00) txtUserName(6) = Format(rst.Fields!lsFee, #0.00) txtUserName(5) = txtUserName(1) * rst.Fields!lMoney * (rst.Fields!lightScale / 100) + txtUserName(1) * txtUserName(4) * (1 - rst.Fields!lightScale / 100) txtUserName(5) = Format(txtUserName(1) * rst.Fields!lMoney * (rst.Fields!lightScale / 100) + rst.Fields!nowecount * rst.Fields!bmoney * (1 - rst.Fields!lightScale / 100), #0.00) txtUserName(8) = rst.Fields(9) txtUserName(7) = Format(Val(txtUserName(5) + Val(txtUserName(6), #0.00) dcNum.Text = rst.Fields(1) End If rst.Close Set rst = NothingEnd SubPrivate Sub dcvalue_KeyPress(KeyAscii As Integer)KeyAscii = 0End SubPrivate Sub del_Click()frmdel.ShowEnd SubPrivate Sub dhcb_Click()usrcopyP.ShowEnd SubPrivate Sub dhcp_Click()frmCopyP.ShowEnd SubPrivate Sub duohu_Click()frmCuifei.muser1 = 2frmCuifei.ShowEnd SubPrivate Sub edit_Click()frmEdit.ShowEnd SubPrivate Sub exit_Click()EndEnd SubPrivate Sub insert_Click()frmInsert.Show 1End SubPrivate Sub jiaonadianfei_Click()frmFee.ShowEnd SubPrivate Sub M_USERYTPE_Click()FRMUSERTYPE.Show 1End SubPrivate Sub MDIForm_Load() loadAdd End SubPublic Sub loadAdd()If rst.State = 1 Then rst.CloseEnd If rst.Open select * from panelinfo where delflagtrue , gCnn, adOpenKeyset, adLockBatchOptimistic If rst.RecordCount 0 Then Set dcvalue.RowSource = rst dcvalue.BoundColumn = holderID dcvalue.ListField = holder Set dcNum.DataSource = rst Set dcNum.RowSource = rst dcNum.ListField = holderid If Not rst.EOF Then dcNum.Text = rst.Fields!holderid dcvalue.Text = rst.Fields(2) txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields!nowecount txtUserName(2) = rst.Fields!cendcode dtpwdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields!lMoney, #0.00) txtUserName(4) = Format(rst.Fields!bmoney, #.0.00) txtUserName(6) = rst.Fields!lsFee txtUserName(5) = Val(txtUserName(1) * Val(txtUserName(3) * (Val(rst.Fields!lightScale) / 100) + Val(txtUserName(1) * Val(txtUserName(4) * (1 - rst.Fields!lightScale / 100) txtUserName(8) = rst.Fields(9) txtUserName(7) = Val(txtUserName(5) + Val(txtUserName(6) rst.Fields!cFeeMoney = txtUserName(7) rst.UpdateBatch adAffectCurrent End If End IfEnd SubPublic Sub loadData(Hid As String) Dim rst As New ADODB.Recordset Dim cnn As New ADODB.Connection Dim Atimes As Integer Dim sqlAdd As String cnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False cnn.CursorLocation = adUseClient cnn.Open If Trim(Hid) Then rst.Open select * from panelinfo where holderid= & Hid & and delflagtrue , cnn, adOpenStatic, adLockBatchOptimistic Else rst.Open select * from panelinfo where delflagtrue , cnn, adOpenStatic, adLockBatchOptimistic End If If Not rst.EOF Then dcNum.Text = rst.Fields!holderid dcvalue.Text = rst.Fields(2) txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields!nowecount txtUserName(2) = rst.Fields!cendcode dtpwdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields!lMoney, #0.00) txtUserName(4) = Format(rst.Fields!bmoney, #0.00) txtUserName(6) = Format(rst.Fields!lsFee, #0.00) txtUserName(5) = Format(txtUserName(1) * txtUserName(3) * (rst.Fields!lightScale / 100) + txtUserName(1) * txtUserName(4) * (1 - rst.Fields!lightScale / 100), #0.00) If rst.Fields!Atimes = 0 Then Atimes = 1 Else Atimes = rst.Fields!Atimes End If txtUserName(5) = Format(Val(txtUserName(1) * txtUserName(3) * Atimes, #0.00) txtUserName(8) = rst.Fields(9) txtUserName(7) = Format(Val(txtUserName(5) + Val(txtUserName(6), #0.00) rst.Fields!cFeeMoney = txtUserName(7) rst.UpdateBatch adAffectCurrent End If rst.Close cnn.Close End SubPrivate Sub MDIForm_Unload(Cancel As Integer)gCnn.CloseSet gcon = NothingEnd SubPrivate Sub mgcf_Click()frmFeefind.ShowEnd SubPrivate Sub mhf_Click()frmdaoru.ShowEnd SubPrivate Sub msf_Click()frmFind1.ShowEnd SubPrivate Sub qianfeilm_Click()frmList.qfFlg = TruefrmList.ShowEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)Select Case Trim(Button.Key)Case afrmFee.Show 1Case b frmCopyP.ShowCase c frmFee.Show 1Case dfrmbeifen.Show 1Case efrmdaoru.Show 1Case ffrmFeefind.Show 1Case gfrmFind1.Show 1Case dhcb1 Case dbcb2Case jX = MsgBox(真的要退出吗?, vbYesNo + vbQuestion, 警告)If X = vbYes ThenEndElseEnd IfEnd SelectEnd SubPrivate Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu) Select Case ButtonMenu.KeyCase dhcb1 frmCopyP.ShowCase dhcb2 usrcopyP.ShowEnd SelectEnd SubPrivate Sub weihu_Click()FRMYHSD.ShowEnd SubPrivate Sub yihu_Click()frmCuifei.muser1 = 1frmCuifei.ShowEnd Sub4. 备份界面设计:备份代码设计:Private Sub Command1_Click()Dim a As Stringa = App.Patha = a & b = Text1.TextOn Error GoTo errhandle:Dim filename As Stringfilename = & Text1.Text & dbdb.mdbIf a = Text1.Text ThenMsgBox 备份目录与原文件目录相同,请重新选择!Exit SubEnd IfIf Dir( & b & dbdb.mdb) ThenDim llp As Stringllp = MsgBox(此目录下已有该文件,要覆盖吗?, vbYesNo, 备份文件)If llp = vbYes ThenKill ( & b & dbdb.mdb)FileCopy & a & datadbdb.mdb, & b & dbdb.mdbDim ll = MsgBox( 备份成功! , vbOKOnly, 提示)ElseExit SubEnd IfElseFileCopy & a & datadbdb.mdb, & b & dbdb.mdbDim llll = MsgBox( 备份成功! , vbOKOnly, 提示)End IfExit Suberrhandle:MsgBox 出现错误,不能复制, vbOKOnly + vbCritical, 复制文件Resume NextEnd SubPrivate Sub Command2_Click()dyMe.HideUnload MeEnd SubPrivate Sub Dir1_Change()Drive1.Drive = Dir1If Right(Dir1.Path, 1) ThenText1.Text = Dir1.Path + ElseText1.Text = Dir1.PathEnd IfCommand1.Enabled = TrueEnd SubPrivate Sub Dir1_Click()If Right(Dir1.Path, 1) ThenText1.Text = Dir1.Path + ElseText1.Text = Dir1.PathEnd IfCommand1.Enabled = TrueEnd SubPrivate Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd SubPrivate Sub Form_Activate()Command1.Enabled = FalsegCnn.CloseChDrive App.PathChDir App.PathText1.SetFocusText1.Text = c:Text1.Text = CurDir()Text1.Enabled = FalseEnd SubPrivate Sub Form_Load()ChDrive App.PathChDir App.PathEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)dyEnd SubPrivate Sub Form_Unload(Cancel As Integer)If gCnn.State = 0 Then gCnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False gCnn.CursorLocation = adUseClient gCnn.OpenEnd IfMDIme.loadAddEnd Sub5. 单户抄表界面设计:单户抄表代码设计:Private Sub Command2_Click() Dim cnn As New ADODB.Connection Dim rstE As New ADODB.Recordset Dim cmdExe As New ADODB.Command Dim nowEv As Double Dim sqlAdd As String If Trim(txtUserName(0).Text) = Then MsgBox 没有要抄表用户,请先添加用户! , vbInformation Exit Sub End If If Trim(txtUserName(9).Text) = Then MsgBox 请先输入数据! , vbInformation Exit Sub End If If Trim(txtUserName(9).Text) Trim(txtUserName(2).Text) Then MsgBox 输入数据错误,当前止码太小! , vbInformation Exit Sub End If cnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False cnn.CursorLocation = adUseClient cnn.Open cmdExe.ActiveConnection = cnn rstE.Open select nowecount from panelinfo where holderID= & Trim(txtUserName(0) & , cnn, adOpenStatic, adLockBatchOptimistic nowEv = Val(rstE.Fields(0).Value) + (Val(txtUserName(9) - Val(txtUserName(2) sqlAdd = update panelinfo set LEndPCode= & Val(txtUserName(2).Text) & ,cEndCode= & Val(txtUserName(9).Text) & ,nowEcount= & nowEv & ,writedate=# & dtpwdate(1) & # where holderID= & Trim(txtUserName(0) & cmdExe.CommandText = sqlAdd cmdExe.Execute sqlAdd cnn.Execute sqlAdd txtUserName(2).Text = txtUserName(9) txtUserName(9) = cnn.Close MsgBox 数据保存完成! , vbInformation Unload Me End SubPrivate Sub Form_Load()Dim rst As New ADODB.RecordsetDim sqlEdit As Stringdtpwdate(1).Value = Format(Now, yyyy-mm-dd)sqlEdit = select * from panelinfo sqlEdit = sqlEdit & where holderid= & Trim(MDIme.txtUserName(0) & and delflagtruerst.Open sqlEdit, gCnn, adOpenStatic, adLockBatchOptimistic If Not rst.EOF Then txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields(2) txtUserName(2) = rst.Fields!cendcode dtpwdate(0).Value = rst.Fields(4) End Ifbuttontime = FalseEnd SubPrivate Sub Form_Unload(Cancel As Integer) MDIme.loadData (txtUserName(0)Cancel = 0End SubPrivate Sub nextuser_Click() Dim rst As New ADODB.RecordsetDim sqlEdit As StringsqlEdit = select * from panelinfo sqlEdit = sqlEdit & where holderid & Trim(txtUserName(0) & and delflagtrue rst.Open sqlEdit, gCnn, adOpenStatic, adLockBatchOptimistic If buttontime = False Then If Not rst.EOF Then txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields(2) txtUserName(2) = rst.Fields!cendcode dtpwdate(0).Value = rst.Fields(4) buttontime = True End IfElse rst.MoveNext If Not rst.EOF Then txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields(2) txtUserName(2) = rst.Fields!cendcode dtpwdate(0).Value = rst.Fields(4) buttontime = True End IfEnd IfEnd SubPrivate Sub txtUserName_KeyPress(Index As Integer, KeyAscii As Integer)If Index = 9 Then If KeyAscii 8 And KeyAscii 46 And KeyAscii 57 Then KeyAscii = 0End IfEnd Sub6. 数据导入界面设计:数据导入代码设计:Private Sub Command1_Click()On Error GoTo errhandle:Dim a As Stringa = App.Patha = a & b = Text1.TextDim filename As StringIf Dir( & a & 计费系统数据库.mdb) ThenDim ll As Stringll = MsgBox(此目录下有此文件要覆盖吗, vbYesNo, 复制文件)If ll = vbYes ThenKill ( & a & 计费系统数据库.mdb)FileCopy & Text1.Text & , & a & 计费系统数据库.mdbDim ll = MsgBox(数据导入成功, vbOKOnly, 提示)ElseExit SubEnd IfElseFileCopy & Text1.Text & , & a & 计费系统数据库.mdbDim llpllp = MsgBox(数据导入成功, vbOKOnly, 提示)End IfExit Suberrhandle:MsgBox 出现错误,不能复制, vbOKOnly + vbCritical, 复制文件End SubPrivate Sub Command2_Click()dyUnload MeEnd SubPrivate Sub Dir1_Change()If Right(Dir1.Path, 1) ThenText1.Text = Dir1.Path + ElseText1.Text = Dir1.PathEnd IfFile1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change()If Drive1.Drive = a: ThenMsgBox 不能从A盘导入Exit SubEnd IfDir1.Path = Drive1.DriveEnd SubPrivate Sub File1_Click()Text1.Text = Text1.Text + File1.filenameCommand1.Enabled = TrueEnd SubPrivate Sub Form_Activate()gCnn.CloseCommand1.Enabled = FalseText1.Text = c:Text1.Text = CurDir()Text1.Enabled = FalseEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)dyUnload MeEnd SubPrivate Sub Form_Unload(Cancel As Integer)If gCnn.State = 0 Then gCnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False gCnn.CursorLocation = adUseClient gCnn.OpenEnd IfMDIme.loadAddEnd Sub7. 数据删除界面设计:数据删除代码设计:Private Sub cmdAsure_Click() If MsgBox( 你确定要删除该数据吗? , vbInformation + vbYesNo) vbYes Then Exit Sub End If If Trim(MDIme.dcvalue.BoundText) Then Dim cnn As New ADODB.Connection Dim sqlAdd As String cnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False cnn.CursorLocation = adUseClient cnn.Open sqlAdd = update panelinfo set delflag=true sqlAdd = sqlAdd & where holderid= & Trim(MDIme.dcvalue.BoundText) & cnn.Execute sqlAdd cnn.Close MsgBox 数据删除完成! , vbInformation End IfEnd SubPrivate Sub Command1_Click()For i = 0 To 10 If i 9 Then MDIme.txtUserName(i) = End IfNextMDIme.dcNum = MDIme.dcvalue = Unload MeEnd SubPrivate Sub Form_Load()Dim rst As New ADODB.RecordsetDim sqlEdit As StringsqlEdit = select * from panelinfo sqlEdit = sqlEdit & where holderid= & Trim(MDIme.txtUserName(0) & and delflagtrue rst.Open sqlEdit, gCnn, adOpenKeyset, adLockBatchOptimisticIf Not rst.EOF Then txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields(2) txtUserName(2) = rst.Fields(3) dtpWdate.Value = rst.Fields(4) txtUserName(3) = rst.Fields(5) txtUserName(4) = Format(rst.Fields(6), #0.00) txtUserName(5) = Format(rst.Fields(7), #0.00) txtUserName(6) = rst.Fields(8) txtUserName(7) = rst.Fields(9) txtUserName(8) = rst.Fields(10) txtUserName(9) = rst.Fields!cendcode changeE = rst.Fields!cendcode cEcount = rst.Fields!nowecount If rst.Fields(14) Null Then DTPicker1.Value = rst.Fields(14) End If txtUserName(10) = rst.Fields!cFeeMoney End If rst.CloseEnd SubPrivate Sub Form_Unload(Cancel As Integer)MDIme.loadAddEnd Sub8. 数据修改界面设计:数据修改代码设计:Dim changeE As Double Dim cEcount As DoublePrivate Sub cmdAsure_Click() If Trim(MDIme.dcvalue.BoundText) Then Dim cnn As New ADODB.Connection Dim sqlAdd As String cnn.ConnectionString = Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= & DbPassword & ;Data Source= & _ App.Path & datadbdb.mdb;Persist Security Info=False cnn.CursorLocation = adUseClient cnn.Open sqlAdd = update panelinfo set holderid= & txtUserName(0) & ,holder= & txtUserName(1) & ,LEndPCode= & txtUserName(2) & ,CopyDate=# & dtpWdate.Value & # ,lightscale= & txtUserName(3) & ,lsfee= & txtUserName(4) & ,lmoney= & txtUserName(5) & ,bmoney= & txtUserName(6) & ,cname= & txtUserName(7) & ,memotext= & txtUserName(8) & ,cEndCode= & txtUserName(9) & ,cFeeMoney= & Val(txtUserName(10) & ,nowecount= & changeE & ,atimes= & Me.Text1 & sqlAdd = sqlAdd & where holderid= & Trim(MDIme.dcvalue.BoundText) & cnn.Execute sqlAdd sqlAdd = update 用户类型 set UNITPRICE= & Me.txtUserName(5) & where ATypeID= & dcob用途.BoundText cnn.Close MsgBox 数据修改完成! , vbInformation End If End SubPrivate Sub Command1_Click()Unload Me End SubPrivate Sub dcob用途_Click(Area As Integer)Dim rst As New ADODB.RecordsetIf dcob用途.BoundText Thenrst.Open select * from 用户类型 where ATypeID= & dcob用途.BoundText & , gCnn, adOpenStatic, adLockBatchOptimisticMe.txtUserName(5) = Format(rst.Fields(2), #0.00)rst.CloseElse MsgBox 请先添加用户电表类型信息! , vbInformation Exit SubEnd IfEnd SubPrivate Sub Form_Load()Dim rst As New ADODB.RecordsetDim sqlEdit As StringsqlEdit = select * from panelinfo sqlEdit = sqlEdit & where holderid= & Trim(MDIme.txtUserName(0) & and delflagtrue rst.Open sqlEdit, gCnn, adOpenKeyset, adLockBatchOptimisticIf Not rst.EOF Then txtUserName(0) = rst.Fields(1) txtUserName(1) = rst.Fields(2) txtUserName(2) = rst.Fields(3) dtpWdate.Value = rst.Fields(4) txtUserName(3) = Format(rst.Fields(5), #0.00) txtUserName(4) = Format(rst.Fields(6), #0.00) txtUserName(5) = Format(rst.Fields(7), #0.00) txtUserName(6) = Format(rst.Fields(8), #0.00) txtUserName(7) = rst.Fields(9) txtUserName(8) = rst.Fields(10) txtUserName(9) = rst.Fields!cendcode Text1.Text = rst.Fields!Atimes changeE = rst.Fields!cendcode cEcount = rst.Fields!nowecount If rst.Fields(14) Null Then DTPicker1.Value = rst.Fields(14) End If txtUserName(10) = rst.Fields!cFeeMoney End IfDim rstJB As New ADODB.RecordsetSet rstJB.ActiveConnection = gCnnrstJB.CursorLocation = adUseClientrstJB.LockType = adLockBatchOptimisticrstJB.CursorType = adOpenKeysetrstJB.Open select * from 用户类型 where atypeid= & rst.Fields!AtypeIDSet dcob用途.DataSource = rstJBSet dcob用途.RowSource = rstJBdcob用途.BoundColumn = ATYPEIDdcob用途.ListField = ATYPEIf rstJB.RecordCount 0 Then dcob用途.Text = rstJB.Fields(1) Me.txtUserName(5) = Format(rstJB.Fields(2), #0.00)End If rst.CloseEnd SubPrivate Sub Form_Unload(Cancel As Integer)MDIme.loadData (txtUserName(0)End SubPrivate Sub txtUserName_Change(Index As Integer)If Index = 9 Then changeE = cEcount + (Val(txtUserName(9) - changeE)End IfEnd SubPrivate Sub UpDown1_Change()Me.Text1 = UpDown1.ValueEnd Sub9. 开始收费界面设计:开始收费代码设计:Private Sub CmdPrint_Click()On Error GoTo lDim LongColor As Long If MsgBox(打印机准备好了吗?, vbYesNo + vbInformation) vbYes Then Exit SubEnd IfMe.CmdPrint.Visible = FalseLongColor = Me.BackColorMe.BackColor = vbWhitetxtPrint.BackColor = vbWhiteMe.PrintFormMe.BackColor = LongColorMe.CmdPrint.Visible = TrueExit Subl: MsgBox Err.DescriptionEnd SubPrivate Sub Command1_Click()Dim rstFeeEnd As New ADODB.RecordsetDim cmdExe As New ADODB.Command Dim reMoney As String Dim sqlString As String If Trim(txtFee) = Or Trim(txtM) = Then MsgBox 请先输入数据!, vbInformation Exit Sub End If reMoney = ConvertMe(Trim(txtFee) Dim Change As String Change = Val(txtM) - Val(txtFee) If Change = 0 Then Me.lblMoneyOfCard = ¥ & Format(Change, #0.00) Else Me.lblMoneyOfCard = 0 End If rstFeeEnd.Open select * from panelinfo where holderid= & MDIme.txtUserName(0) & and delflagtrue , gCnn, adOpenStatic, adLockBatchOptimistic Dim rusrType As New ADODB.Recordset If rstFeeEnd.RecordCount 0 Then rusrType.Open select * from 用户类型 where AtypeID= & rstFeeEnd.Fields!AtypeID, gCnn, adOpenStatic, adLockBatchOptimistic If rusrType.RecordCount 0 Then Me.lblusrYype = rusrType.Fields!AType rusrType.Close Else MsgBox 用户类型不能为空! , vbCritical rusrType.Close Unload Me End If End If Me.Label11 = rstFeeEnd.Fields!Atimes Me.Label11 = Me.Label11 & / & Format(rstFeeEnd.Fields!lMoney, #0.00) rstFeeEnd.Fields!nowecount = 0 Me.startA = rstFeeEnd.Fields!LEndPCode & 度 rstFeeEnd.Fields!lecount = rstFeeEnd.Fields!lecount + rstFeeEnd.Fields!nowecount MsgBox MDIme.txtUserName(7) rstFeeEnd.Fields!lsFee = Val(MDIme.txtUserName(7) - Val(txtM) rstFeeEnd.UpdateBatch adAffectCurrent rstFeeEnd.Close sqlString = insert into feels (holderid,holder,feemoney,qianfee,feedate,zhinajin,memols,cname,Ecount) values( & MDIme.txtUserName(0) & , & MDIme.dcvalue.Text & , & Val(txtFee.Text) & , & Val(txtM.Text) & ,# & Format(Now, yyyy-mm-dd) & #, & Val(txtznj) & , & txtPrint & , & Guser & , & MDIme.txtUserName(1) & ) cmdExe.ActiveConnection = gCnn cmdExe.CommandText = sqlString cmdExe.Execute txtPrint.Visible = True Me.CmdPrint.Visible = True Frame2.Visible = FalseEnd Sub Private Sub Command3_Click()Unload MeEnd SubPrivate Sub Form_Load()Me.Caption = MDIme.dcvalue.Text & 用户(住户编号: & MDIme.txtUserName(0) & ) 开始交费txtFee.Text = MDIme.txtUserName(7)End SubPrivate Sub Form_Unload(Cancel As Integer)MDIme.loadData (MDIme.txtUserName(0)End Sub Private Sub txtFee_KeyPress(KeyAscii As Integer)If KeyAscii 8 And KeyAscii 46 And KeyAscii 57 Then KeyAscii = 0End SubPrivate Sub txtM_KeyPress(KeyAscii As Integer)If KeyAscii 8 And KeyAscii 46 And KeyAscii 57 Then KeyAscii = 0End SubPrivate Sub txtznj_KeyPress(KeyAscii As Integer)If KeyAscii 8 And KeyAscii 46 And KeyAscii 57 Then KeyAscii = 0End Sub10:数据查询界面设计:数据查询代码设计:Private Sub cmdExport_Click()导出网格数据到EXCEL中 Export rsdg, Me.dgexp, 数据查询, 日期: & Format(Now, yyyy-mm-dd), 总电量: & txtCountA & 度 总金额: & txtCount & 元End SubPrivate Sub cmdQuery_Click()Dim Sqlstr As StringDim whrStr As StringDim feeC As DoubleDim znjC As DoubleDim rstRg As New ADODB.Recordset拼Where 语句whrStr = getWhrStr()取得网格的数据 Sqlstr = select * from feels & whrStr & MsgBox SqlstrIf rsdg.State = 1 Then rsdg.CloseEnd Ifrsdg.Open Sqlstr, gCnn, adOpenStatic, adLockOptimisticDebug.Print SqlstrSet rsdg = getQueryData(Sqlstr)Set dgexp.DataSource = rsdgSqlstr = select sum(feeMoney),sum(Ecount) from feels & whrStr & If rstRg.State = 1 Then rstRg.CloseEnd IfrstRg.Open Sqlstr, gCnn, adOpenStatic, adLockBatchOptimistictxtCount = Format(rstRg.Fields(0), #0.00) & txtCountA = rstRg.Fields(1) & rstRg.CloseMsgBox 数据查询完成,共 & rsdg.RecordCount & 条纪录!, vbInformationEnd SubPrivate Function getWhrStr() As String功能描述:拼凑Where语句返回串值Dim whrS
- 温馨提示:
1: 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
2: 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
3.本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

人人文库网所有资源均是用户自行上传分享,仅供网友学习交流,未经上传用户书面授权,请勿作他用。