《用ACCESS制作的会计记账程序》代码
时 间:2018-10-16 18:06:02
作 者:wangbohai ID：69809 城市：北京
摘 要:这是一套实用的企业会计记账程序，它可以将流水账整理成科目汇总账和各科目总分类账，并能通过上年结转数计算出详尽的余额数据，与传统账本相差无几，基本上满足了会计工作的需要。
正 文:
《用ACCESS制作的会计记账程序》
这是一套实用的企业会计记账程序，它可以将流水账整理成科目汇总账和各科目总分类账，并能通过上年结转数计算出详尽的余额数据，与传统账本相差无几，基本上满足了会计工作的需要。只要电脑上有ACCESS就可以使用这个程序，没有其它限制。
本程序使用的都是极其简单的窗体SQL语言，代码完全公开，需要者可以根据需要进行改造。这套程序主要包括一个运算主程序和数据输入界面及若干窗口布置设计。
以下是运算主程序的代码，对ACCESS有所了解的人很容易通过它在窗口布置出文本框、按钮等匹配部分。记账凭证可以在ACCESS中录入，也可以导入EXCEL数据。建库的录入部分另有一个小小的程序，需要者请提出，也可以自行编制。
本程序虽检测成功，但仍有一些不足之处。由于时间的精力的有限，没有做进一步的精简、修饰和包装，仅供交流学习，抛砖引玉。粗糙之处敬请谅解，欢迎指错斧正。
王波海，2018年10月于北京。
Option Compare Database
Public b As String
Public c As String
Public d As String
Public e As String
Public k As String
Public y As String
Public rq As String
Public rq2 As String
Public km As String
Public jd As String
Public zy As String
Public ye As Variant
Private Sub Command0_Click()
Dim SQL As String
Dim SQL2 As String
Dim SQL3 As String
Dim SQL4 As String
Dim SQL5 As String
Dim SQL6 As String
Dim SQL7 As String
Dim SQL8 As String
Dim SQL9 As String
Dim SQL10 As String
Dim SQL11 As String
Dim SQL12 As String
Dim SQL13 As String
Dim SQL14 As String
Dim SQL15 As String
Dim SQL16 As String
Dim SQL17 As String
Dim SQL18 As String
Dim SQL19 As String
Dim SQL20 As String
Dim SQL21 As String
Dim SQL22 As String
Dim drop1 As String
Dim drop2 As String
Dim drop3 As String
Dim drop4 As String
Dim drop5 As String
Dim qqs As String
Dim qqs1 As String
Dim qqs2 As String
Dim qqs3 As String
Dim qqs4 As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fd As DAO.Field
Dim mykm1 As Variant
Dim mykm2 As Variant
Dim mykm3 As Variant
Dim mykm4 As Variant
Dim myjd1 As Variant
Dim myjd2 As Variant
Dim myjd3 As Variant
Dim myjd4 As Variant
'Dim myid(30) As Variant
Dim mysql As String
Dim kuming As String
'Dim km As String
Dim i As Integer
Dim j As Integer
Dim m As String
Dim eof1 As Integer
Dim zy1 As String
Dim rs2 As New ADODB.Recordset
Dim strSql As String
DoCmd.SetWarnings False
a = InputBox("输入年份", "输入年份窗口,默认=2017 ", "2017", 5000, 5000)
'Me!Text0.SetFocus
'Me!Text0.Value = a
a = CStr(a)
b = "01"
e = CStr(CDbl(b) - 1)
d = CStr(CDbl(b))
b = CStr(b)
c = a + b
rq = a + b
rq2 = rq - 1
km = InputBox("输入科目", "输入科目窗口默认=银行存款 ", "银行存款 ", 5000, 5000)
km = Trim(km)
'zcl = InputBox("是否为资产类科目（输入Y或者N）", "选择是否为资产类科目科目窗口（默认认=Y） ", "Y", 5000, 5000)
qqs = InputBox("输入上年" + km + "结转额", "输入上年结转额窗口,默认=0 ", "0 ", 5000, 5000)
jd = InputBox("上年结转额是借还是贷,j为借 d为贷 n为没有 ", "输入上年结转额借贷j/d/n窗口.默认=j", "j", 5000, 5000)
If MsgBox("是否继续？" & vbCrLf & "是=继续，否=退出", vbYesNo, "财务分类账") = vbNo Then
Exit Sub
End If
qqs1 = "Select" + "[" + a + "]" + ".id" _
+ "," + "[" + a + "]" + ".日期" _
+ "," + "[" + a + "]" + ".顺序号" _
+ "," + "[" + a + "]" + ".摘要" _
+ " INTO " + a + "上年" + Trim(km) + "结转" _
+ " FROM " + a _
+ " Where 顺序号=999999"
DoCmd.RunSQL qqs1
qqs4 = "Insert INTO " + a + "上年" + Trim(km) + "结转 " _
+ "(摘要) values (' ')"
DoCmd.RunSQL qqs4
qqs2 = "alter table " + a + "上年" + Trim(km) + "结转 add 借方 money,贷方 money,借贷 char,余额 money"
DoCmd.RunSQL qqs2
qqs3 = "Update " + a + "上年" + Trim(km) + "结转 SET 摘要 = '上年结转'," _
+ "余额=" + qqs + ",顺序号 = rq-1" + ",借贷=jd"
DoCmd.RunSQL qqs3
'MsgBox (rq & km & "上年结转完成,请继续。")
'=================================================================
For i = 1 To 12
SQL = "Select " + "[" + a + "]" + ".日期 " _
+ "," + "[" + a + "]" + ".顺序号 " _
+ "," + "[" + a + "]" + ".摘要 " _
+ "," + "[" + a + "]" + ".金额 " + "AS 借方 " _
+ "INTO " + a + "借方" + km _
+ " FROM " + a _
+ " Where (((" + " [" + a + "]" + ".借方科目)=" _
+ " '" + km + "'" + ")" _
+ " AND ((Month([日期]))=" + d + "))"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL
SQL2 = "alter table " + a + "借方" + km + " add 贷方 money,借贷 char(4) ,余额 money"
DoCmd.RunSQL SQL2
SQL2 = "Update " + a + "借方" + km + " SET 借贷 ='j'"
DoCmd.RunSQL SQL2
SQL3 = "Select " + "[" + a + "]" + ".日期 " _
+ "," + "[" + a + "]" + ".顺序号 " _
+ "," + "[" + a + "]" + ".摘要 " _
+ "," + "[" + a + "]" + ".金额 " + "AS 贷方 " _
+ "INTO " + a + "贷方" + km _
+ " FROM " + a _
+ " Where (((" + " [" + a + "]" + ".贷方科目)=" _
+ " '" + km + "'" + ")" _
+ " AND ((Month([日期]))=" + d + "))"
DoCmd.RunSQL SQL3
SQL4 = "alter table " + a + "贷方" + km + " add 借方 money,借贷 char(4) ,余额 money"
DoCmd.RunSQL SQL4
SQL4 = "Update " + a + "贷方" + km + " SET 借贷 ='d'"
DoCmd.RunSQL SQL4
SQL5 = "insert into " + a + "借方" + km + "(日期, 顺序号,摘要,贷方,借贷) select 日期,顺序号,摘要,贷方,借贷 from " + a + "贷方" + km
DoCmd.RunSQL SQL5
SQL6 = "Select Sum([" + a + "借方" + km + "].借方) AS 借方, Sum([" + a + "借方" + km + "].贷方) AS 贷方 INTO " + a + "借贷方" + km + "合计" + " FROM " + a + "借方" + km
DoCmd.RunSQL SQL6
SQL7 = "Insert INTO " + a + "借方" + km + "(借方,贷方,顺序号,摘要)" + " Select " + "借方, 贷方," + rq + ", '本月合计'" + " FROM " + a + "借贷方" + km + "合计"
DoCmd.RunSQL SQL7
SQL8 = "Insert INTO " + a + "上年" + km + "结转(日期,借方, 贷方, 顺序号, 摘要) Select 日期,借方, 贷方, 顺序号, 摘要 FROM " + a + "借方" + km
DoCmd.RunSQL SQL8
SQL9 = "Select" + "[" + a + "上年" + km + "结转" + "]" + ".日期" _
+ "," + "[" + a + "上年" + km + "结转" + "]" + ".顺序号" _
+ "," + "[" + a + "上年" + km + "结转" + "]" + ".摘要" _
+ "," + "[" + a + "上年" + km + "结转" + "]" + ".借方" _
+ "," + "[" + a + "上年" + km + "结转" + "]" + ".贷方" _
+ "," + "[" + a + "上年" + km + "结转" + "]" + ".余额" _
+ " INTO " + a + km + "余额计算1" _
+ " FROM " + a + "上年" + km + "结转" _
+ " Where 顺序号=rq or 顺序号=rq-1"
DoCmd.RunSQL SQL9
SQL10 = "alter table " + a + km + "余额计算1 add 本月合计 money, 上月余额 money,借贷 char(4) "
DoCmd.RunSQL SQL10
SQL11 = "Update " + a + km + "余额计算1" + " SET 本月合计 = 借方 Where 顺序号=" + rq
'MsgBox (SQL11)
DoCmd.RunSQL SQL11
SQL12 = "Update " + a + km + "余额计算1" + " SET 贷方=0, 借方=0 Where 顺序号=rq - 1"
'MsgBox (SQL12)
DoCmd.RunSQL SQL12
SQL13 = "Select Sum([" + a + km + "余额计算1].借方) AS 借方," _
+ " Sum([" + a + km + "余额计算1].贷方) AS 贷方," _
+ " Sum([" + a + km + "余额计算1].余额) AS 余额," _
+ " Sum([" + a + km + "余额计算1].本月合计) AS 本月合计," _
+ " Sum([" + a + km + "余额计算1].上月余额) AS 上月余额" _
+ " INTO " + a + km + "余额计算2" _
+ " from " + a + km + "余额计算1"
'MsgBox (SQL13)
DoCmd.RunSQL SQL13
SQL14 = "alter table " + a + km + "余额计算2 add 顺序号 integer,借贷 char(4)"
'MsgBox (SQL14)
DoCmd.RunSQL SQL14
SQL15 = " Update " + a + km + "余额计算2 SET 上月余额=余额, 顺序号 = " + rq
'MsgBox (SQL15)
DoCmd.RunSQL SQL15
SQL16 = "Update " + a + km + "余额计算2 SET 本月合计 = 0 Where 本月合计 is null"
'MsgBox (SQL16)
DoCmd.RunSQL SQL16
SQL17 = "Update " + a + km + "余额计算2 SET 贷方= 0 Where 贷方 is null"
'MsgBox (SQL17)
DoCmd.RunSQL SQL17
SQL18 = "Update " + a + km + "余额计算2 SET 上月余额 = 0 Where 上月余额 is null"
'MsgBox (SQL18)
DoCmd.RunSQL SQL18
'If zcl = "Y" Then
' SQL19 = "Update " + a + km + "余额计算2 SET 余额=上月余额+本月合计-贷方,借贷='j' where 顺序号 = " + rq
'
'Else
'
' SQL19 = "Update " + a + km + "余额计算2 SET 余额=上月余额+贷方-本月合计,借贷='d' where 顺序号 = " + rq
'
'End If
'MsgBox (SQL19)
'DoCmd.RunSQL SQL19
'If zcl = "Y" Then
' SQL20 = "Update " + a + km + "余额计算2 SET 借贷='d' where 顺序号 = " + rq + " and 余额<0"
' Else
' SQL20 = "Update " + a + km + "余额计算2 SET 借贷='j' where 顺序号 = " + rq + " and 余额<0"
'End If
'DoCmd.RunSQL SQL20
SQL21 = "Update " + a + km + "余额计算2 SET 借贷=' 'where 顺序号 = " + rq + " and 余额=0"
DoCmd.RunSQL SQL21
SQL22 = "Update " + a + "上年" + km + "结转 AS a," + a + km + "余额计算2 AS b SET a.余额 = b.余额,a.借贷 = b.借贷 Where a.顺序号=b.顺序号"
'MsgBox (SQL22)
DoCmd.RunSQL SQL22
drop1 = "drop table " + a + "贷方" + km
drop2 = "drop table " + a + km + "余额计算1"
drop3 = "drop table " + a + km + "余额计算2"
drop4 = "drop table " + a + "借贷方" + km + "合计"
drop5 = "drop table " + a + "借方" + km
DoCmd.RunSQL drop1
DoCmd.RunSQL drop2
DoCmd.RunSQL drop3
DoCmd.RunSQL drop4
DoCmd.RunSQL drop5
d = d + 1
rq = CStr(CDbl(rq) + 1)
Next i
'MsgBox ("分类完成")
'If MsgBox("是否继续？" & vbCrLf & "是=继续，否=退出。", vbYesNo, "财务分类账") = vbNo Then
'Exit Sub
'Else
'DoCmd.Close
'End If
'---------------------------------------------------------
kuming = a + "上年" + km + "结转"
Set db = CurrentDb()
Set rs = db.OpenRecordset(kuming)
'Set fd = rs.Fields("借方")
DoCmd.SetWarnings False
'DoCmd.SetWarnings True
'mysql = "Update " + kuming + " SET 借贷='借' Where 借贷 = 'j' "
'DoCmd.RunSQL mysql
'mysql = "Update " + kuming + " SET 借贷='j' "
'DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 借贷='n' Where 借贷 is null"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 贷方= 0 Where 贷方 is null "
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 借方= 0 Where 借方 is null"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 余额= 0 Where 余额 is null"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 摘要= '无' Where 摘要 is null"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 借贷='d' Where 贷方 <> 0"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 借贷='j' Where 借方 <> 0"
DoCmd.RunSQL mysql
mysql = "Update " + kuming + " SET 借贷='n' Where 借方 = 0 and 贷方 = 0 and 余额 = 0"
DoCmd.RunSQL mysql
'MsgBox ("借贷方标识完成")
'If MsgBox("是否继续？" & vbCrLf & "是=继续，否=退出。", vbYesNo, "财务分类账") = vbNo Then
' Exit Sub
'Else
' DoCmd.Close
'End If
'---------------------------------------------------------------------------
k = 0
eof1 = rs.RecordCount - 1
'MsgBox ("eof1=" & eof1)
rs.MoveFirst
For i = 1 To eof1
mykm1 = rs.Fields("余额")
myjd1 = rs.Fields("借贷")
myjd1 = Trim(myjd1)
rs.MoveNext
mykm2 = rs.Fields("借方")
myjd2 = rs.Fields("借贷")
myjd2 = Trim(myjd2)
mykm3 = rs.Fields("贷方")
myjd3 = rs.Fields("借贷")
myjd3 = Trim(myjd3)
If myjd1 = "j" And myjd2 = "j" Then
k = mykm1 + mykm2 - mykm3
If k > 0 Then
myjd4 = "j"
End If
If k < 0 Then
myjd4 = "d"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "j" And myjd2 = "d" Then
k = mykm1 + mykm2 - mykm3
If k > 0 Then
myjd4 = "j"
End If
If k < 0 Then
myjd4 = "d"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "j" And myjd2 = "n" Then
k = mykm1 + mykm2 - mykm3
If k > 0 Then
myjd4 = "j"
End If
If k < 0 Then
myjd4 = "d"
End If
If k = 0 Then
myjd4 = "n "
k = 0
End If
k = Abs(k)
End If
If myjd1 = "d" And myjd2 = "d" Then
k = mykm1 + mykm3 - mykm2
If k > 0 Then
myjd4 = "d"
End If
If k < 0 Then
myjd4 = "j"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "d" And myjd2 = "j" Then
k = mykm1 + mykm3 - mykm2
If k > 0 Then
myjd4 = "d"
End If
If k < 0 Then
myjd4 = "j"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "d" And myjd2 = "n" Then
k = mykm1 + mykm3 - mykm2
If k > 0 Then
myjd4 = "d"
End If
If k < 0 Then
myjd4 = "j"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "n" And myjd2 = "n" Then
k = mykm1 + mykm2 - mykm3
If k > 0 Then
myjd4 = "n"
End If
If k < 0 Then
myjd4 = "n"
End If
If k = 0 Then
myjd4 = "n"
k = 0
End If
k = Abs(k)
End If
If myjd1 = "n" And myjd2 = "d" Then
k = mykm1 + mykm3 - mykm2
If k < 0 Then
myjd4 = "j"
End If
If k > 0 Then
myjd4 = "d"
End If
If k = 0 Then
myjd4 = "n"
End If
k = Abs(k)
End If
If myjd1 = "n" And myjd2 = "j" Then
k = mykm1 + mykm2 - mykm3
If k < 0 Then
myjd4 = "d"
End If
If k > 0 Then
myjd4 = "j"
End If
If k = 0 Then
myjd4 = "n"
End If
k = Abs(k)
End If
'rs.Edit
'zy1 = rs.Fields("id")
'MsgBox (zy1 & " : " & zy)
zy = rs.Fields("摘要")
If zy <> "本月合计" Then
rs.Edit
rs.Fields("余额") = k
rs.Fields("借贷") = myjd4
rs.Update
k = 0
Else
rs.MovePrevious
ye = rs.Fields("余额")
myjd4 = rs.Fields("借贷")
rs.MoveNext
rs.Edit
rs.Fields("余额") = ye
rs.Fields("借贷") = myjd4
rs.Update
k = 0
End If
Next
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
mysql = "Update " + kuming + " SET 借贷='n' Where 借方 = 0 and 贷方 = 0 and 余额 = 0"
DoCmd.RunSQL mysql
MsgBox (km & "科目明细分类账全部完成")
'a = InputBox("输入年份", "输入年份窗口,默认=2017 ", "2017", 5000, 5000)
a = Trim(a)
b = a
'km = InputBox("输入科目", "输入科目窗口默认=银行存款 ", "银行存款 ", 5000, 5000)
km = Trim(km)
c = km
km = a + "上年" + km + "结转"
kuming = Trim(km)
a = kuming
m = b + c + "总分类账"
''strSql = "select Name from MsysObjects where type=1 and Flags=0 and Name=" + "'" + a + "'"
'rs2.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
'If rs2.RecordCount < 1 Then
' MsgBox a & "表不存在，请先建表。"
' Exit Sub
'Else
' MsgBox a & "表已经存在。"
'End If
qqs1 = "Select" + "[" + a + "]" + ".id" _
+ "," + "[" + a + "]" + ".日期" _
+ "," + "[" + a + "]" + ".顺序号" _
+ "," + "[" + a + "]" + ".摘要" _
+ "," + "[" + a + "]" + ".借方" _
+ "," + "[" + a + "]" + ".贷方" _
+ "," + "[" + a + "]" + ".借贷" _
+ "," + "[" + a + "]" + ".余额" _
+ " INTO " + m _
+ " FROM " + a _
+ " Where 摘要 = '上年结转'or 摘要 = '本月合计'"
DoCmd.RunSQL qqs1
qqs1 = "Select Sum([" + m + "].借方) AS 借方, Sum([" + m + "].贷方) AS 贷方, Sum([" + m + "].余额) AS 余额 INTO " + m + "合计" + " FROM " + m
'MsgBox qqs1, 4
DoCmd.RunSQL qqs1
qqs1 = "Insert INTO " + m + "(借方,贷方)" + " Select " + "借方,贷方 FROM " + m + "合计"
DoCmd.RunSQL qqs1
qqs1 = "Update " + m + " SET 摘要 = '本年合计' Where 摘要 is null"
DoCmd.RunSQL qqs1
drop1 = "drop table " + m + "合计"
DoCmd.RunSQL drop1
km = m + "合计"
Set rs = CurrentDb().OpenRecordset(m)
rs.MoveLast
rs.MovePrevious
mykm1 = rs.Fields("余额")
'MsgBox ("mykm1=" & mykm1)
rs.MoveLast
rs.Edit
rs.Fields("余额") = mykm1
rs.Update
rs.Close
MsgBox (m & "完成")
End Sub
'-----------------------------------------------------------------
Private Sub Command1_Click()
Dim akm As String
Dim sqlkm As String
Dim rs As New ADODB.Recordset
Dim strSql As String, strg As String
akm = InputBox("输入年份", "输入年份窗口,默认=2017 ", "2017", 5000, 5000)
'a = "2017"
sqlkm = "Select " + " [" + akm + "]" + ".借方科目" _
+ "," + "Count(" + " [" + akm + "]" + ".金额) AS 金额之计数" _
+ " INTO " + akm + "借方科目名称汇总" _
+ " FROM " + akm + " GROUP BY " + " [" + akm + "]" + ".借方科目 " _
+ "HAVING (((" + " [" + akm + "]" + ".借方科目)>'1')) "
DoCmd.SetWarnings False
DoCmd.RunSQL sqlkm
sqlkm = "Select " + " [" + akm + "]" + ".贷方科目" _
+ "," + "Count(" + " [" + akm + "]" + ".金额) AS 金额之计数" _
+ " INTO " + akm + "贷方科目名称汇总" _
+ " FROM " + akm + " GROUP BY " + " [" + akm + "]" + ".贷方科目 " _
+ "HAVING (((" + " [" + akm + "]" + ".贷方科目)>'1')) "
DoCmd.RunSQL sqlkm
'MsgBox ("借方科目名称汇总己生成")
'Me.Text4 = sqlkm
strSql = "select 借方科目 from " + akm + "借方科目名称汇总"
rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
Do Until rs.EOF
strg = strg & rs!借方科目 & vbCrLf
' MsgBox (strg)
rs.MoveNext
Loop
Text4 = strg
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
'MsgBox ("借方科目名称汇总己生成")
'Me.Text4 = sqlkm
strSql = "select 贷方科目 from " + akm + "贷方科目名称汇总"
rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
Do Until rs.EOF
strg = strg & rs!贷方科目 & vbCrLf
' MsgBox (strg)
rs.MoveNext
Loop
Text6 = strg
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
End Sub
Private Sub Command2_Click()
'If MsgBox("是否继续？" & vbCrLf & "是=继续，否=退出。", vbYesNo, "财务分类账") = vbNo Then
' Exit Sub
'Else
' DoCmd.Close
'End If
End Sub
Private Sub Command3_Click()
MsgBox (" 该功能己并入分类汇总。" & vbCrLf & "做完科目分类汇总后自动形成科目总分类账.")
DoCmd.Close
Exit Sub
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fd As DAO.Field
Dim mykm1 As Variant
Dim mykm2 As Variant
Dim mykm3 As Variant
Dim mykm4 As Variant
Dim myjd1 As Variant
Dim myjd2 As Variant
Dim myjd3 As Variant
Dim myjd4 As Variant
Dim mysql As String
Dim kuming As String
Dim km As String
Dim i As Integer
Dim j As Integer
Dim m As String
Dim eof1 As Integer
Dim zy1 As String
Dim rs2 As New ADODB.Recordset
Dim strSql As String
DoCmd.SetWarnings False
'---------------------------------------------------------
a = InputBox("输入年份", "输入年份窗口,默认=2017 ", "2017", 5000, 5000)
a = Trim(a)
b = a
km = InputBox("输入科目", "输入科目窗口默认=银行存款 ", "银行存款 ", 5000, 5000)
km = Trim(km)
c = km
km = a + "上年" + km + "结转"
kuming = Trim(km)
a = kuming
m = b + c + "总分类账"
strSql = "select Name from MsysObjects where type=1 and Flags=0 and Name=" + "'" + a + "'"
rs2.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
If rs2.RecordCount < 1 Then
MsgBox a & "表不存在，请先建表。"
Exit Sub
Else
MsgBox a & "表已经存在。"
End If
qqs1 = "Select" + "[" + a + "]" + ".id" _
+ "," + "[" + a + "]" + ".日期" _
+ "," + "[" + a + "]" + ".顺序号" _
+ "," + "[" + a + "]" + ".摘要" _
+ "," + "[" + a + "]" + ".借方" _
+ "," + "[" + a + "]" + ".贷方" _
+ "," + "[" + a + "]" + ".借贷" _
+ "," + "[" + a + "]" + ".余额" _
+ " INTO " + m _
+ " FROM " + a _
+ " Where 摘要 = '上年结转'or 摘要 = '本月合计'"
DoCmd.RunSQL qqs1
qqs1 = "Select Sum([" + m + "].借方) AS 借方, Sum([" + m + "].贷方) AS 贷方, Sum([" + m + "].余额) AS 余额 INTO " + m + "合计" + " FROM " + m
'MsgBox qqs1, 4
DoCmd.RunSQL qqs1
qqs1 = "Insert INTO " + m + "(借方,贷方)" + " Select " + "借方,贷方 FROM " + m + "合计"
DoCmd.RunSQL qqs1
qqs1 = "Update " + m + " SET 摘要 = '本年合计' Where 摘要 is null"
DoCmd.RunSQL qqs1
drop1 = "drop table " + m + "合计"
DoCmd.RunSQL drop1
km = m + "合计"
Set rs = CurrentDb().OpenRecordset(m)
rs.MoveLast
rs.MovePrevious
mykm1 = rs.Fields("余额")
'MsgBox ("mykm1=" & mykm1)
rs.MoveLast
rs.Edit
rs.Fields("余额") = mykm1
rs.Update
rs.Close
MsgBox (m & "完成")
End Sub
Access软件网官方交流QQ群 (群号:54525238) Access源码网店
相关文章:
【转】家庭记账系统 【UMVsoft整理 2009/1/31】 【Access快速开发平台源码作品】Access进销存及财务管理系统，access做进销存很轻松实现你的管理目标 【耿云 2015/3/25】 财务收支的累计余额示例 【恐龙的传人 2015/3/30】 【财务系统】应付账款查询系统 【麥田 2016/7/7】 《财务数据管理平台》凭借多年财务管理经验，进行业务评估与结合实际业务管理编写的一套Access对接SAP数据的软件 【郭建明 2017/2/14】 云记账管理系统【进一步优化】 【fan0217 2017/9/28】 快速开发《财务管理系统》视频课程 【张志 2018/10/3】Access网店:
Access快速开发平台--操作员只能查看自己的数据，管理员可以查看所有数据
价格：￥500 元.gif)
Access快速开发平台--打印预览选中的多项记录示例
价格：￥100 元
【Access报表】打印查询结果到报表，多条件查询符合条件的记录并用报表打印
价格：￥50 元
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- Access对子窗体数据进行批...(10.30)
- 最精简的组合框行来源数据快速输...(10.25)
- Access仿平台的多值选择器...(10.24)
- 【Access日期区间段查询】...(10.22)
- 【Access源码示例】VBA...(10.12)
- Access累乘示例，Acce...(10.09)
- 数值8.88，把整数8去掉，转...(10.08)
- 【Access自定义函数】一个...(09.30)
- 【Access选项卡示例】Ac...(09.09)
学习心得
最新文章
- Access快速开发平台--对上传...(11.22)
- Access快速开发平台企业版--...(11.18)
- 不会用多表联合查询，多表查询没结果...(11.16)
- 【案例分享】主键字段值含有不间断空...(11.16)
- Access快速开发平台--后台D...(11.14)
- 微软Access邀测新Monaco...(11.12)
- Access列表框左右互选、列表框...(11.11)
- 高效率在导入数据前删除记录(11.10)
- Access报价单转订单示例代码(11.08)
- Access系统自带的日期选择器不...(11.08)
