“小管家—Excel财务管理系统”(V13)

xj.cpa

路过♂风ぃ… 发表于 2016-2-1 14:14
怎样输入年初数啊？

请参见应用指南中关于科目初始化部分

113747454

新手求助，学了一天，录凭证很好用啊，但我的财务报务总是不对，发现科目汇总表－本期发生额全部为空。如何设置本期发生额？？

xj.cpa

113747454 发表于 2016-2-2 18:38
新手求助，学了一天，录凭证很好用啊，但我的财务报务总是不对，发现科目汇总表－本期发生额全部为空。如何 ...

你刷新一下月份试试

113747454

没用，连续三个月的账都没有本月发生额，我的科目只增设了几个二级科目，一级的都没有变动，不知怎么会这样

113747454

呃，怎么你们都能用，我的还是不行，折腾两天了，我刚才又装了个excel2003,同时在2003、2010下试，在不改动任何科目的情况下，输入凭证，科目汇总表还是不能汇总本月发生额。唉唉，无语了。这个软件很好，如果能解决这问题，很多小企业每月凭证少，用这人刚好，我怎么会用不了呢，怪了。谁能帮帮我。

xj.cpa

113747454 发表于 2016-2-2 22:13
呃，怎么你们都能用，我的还是不行，折腾两天了，我刚才又装了个excel2003,同时在2003、2010下试，在不改动 ...

请发生我邮箱，我为你检查！

jilinge2

王老师，请问下常用凭证那里能简单修改下代码吗？能否添加2个按钮（功能就是科目汇总表把《所有下级科目》和《同时没有月初数、发生额、余额的一级科目》隐藏掉，另一个按钮是显示所有行，这样方便打印科目汇总表。

1. Sub 隐藏行()
   
2. Application.ScreenUpdating = False
   
3.     For i = 6 To 200
   
4.         If Application.Sum(Range("o" & i & ":p" & i)) = 0 And Application.Range("r" & i) = 0 And Application.Range("t" & i) = 0 And Application.Sum(Range("aa" & i & ":ab" & i)) = 0 Or Application.Range("f" & i) > 1 Then Rows(i & ":" & i).Hidden = True
   
5.     Next
   
6. Application.ScreenUpdating = True
   
7. Range("D6").Select
   
8. End Sub
   
9. 
   
10. Sub 显示行()
    
11. Cells.Select
    
12.     Selection.EntireRow.Hidden = False
    
13.     Range("D6").Select
    
14. End Sub
    

复制代码

修改第32-49行为这样会影响整个表吗？（在第38行添加了一行判断条件，44-46行改了下循环条件，其他都没变）就是结转的时候把没有数据的科目直接跳过去，只把有数的科目填写进入凭证里，因为有时候不注意就会删错行，把有数的删了。

1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
2. If Sheets("数据库").Cells(21, 4) = "会计科目 " Then
   
3. Exit Sub
   
4. ElseIf Target.Row = 2 And Target.Column = 2 Then
   
5. Sheets("首页").Select
   
6. ElseIf Target.Row > 5 And Target.Row < Cells(1, 2) And Target.Column = 7 Then
   
7. Cells(Target.Row + 1, 7).Select
   
8. If Sheets("数据库").Cells(20, 5) = "存货管理" Then
   
9. MsgBox "非常抱歉，在存货管理系统下没有常用凭证操作功能 ！", 48, "   不能操作常用凭证 ！"
   
10. ElseIf Sheets("数据库").Cells(27, 4) <> "制单" Then
    
11. MsgBox "对不起,您没有此项操作权限 ！", 48, "   非法操作 ！"
    
12. ElseIf Cells(Cells(1, 2), 11) <> Cells(Cells(1, 2), 12) Then
    
13. MsgBox "您的数据借贷方不平，请检查 ！", 48, "   借贷不平 ！"
    
14. ElseIf Cells(Target.Row, 7) <> "" And Cells(Target.Row, 8) <> "" And Cells(Target.Row + 1, 8) <> "" _
    
15. And (Target.Row = 6 Or Cells(Target.Row - 1, 8) = "") Then
    
16. If MsgBox("如果本月有关业务已处理完毕，现在需要处理常用凭证，请选择“确定”，否则选择“取消”！", 289, "     要处理常用凭证吗？") = vbOK Then
    
17. With Sheets("常用凭证")
    
18. k = Target.Row
    
19. Sheets("凭证管理").Select
    
20. If Sheets("首页").Cells(3, 4) = "小管家—Excel进销存管理系统" Then
    
21. Sheets("凭证管理").Cells(2, 4) = "记 账 凭 证"
    
22. End If
    
23. If Sheets("数据库").Cells(16, 4) = 5 Then
    
24. ElseIf Sheets("凭证管理").Cells(3, 5) = Sheets("数据库").Cells(Sheets("数据库").Cells(16, 4) - 1, 10) + 1 Then
    
25. Sheets("凭证管理").Cells(3, 13) = 1
    
26. Else
    
27. Sheets("凭证管理").Cells(3, 5) = Sheets("数据库").Cells(Sheets("数据库").Cells(16, 4) - 1, 10)
    
28. Sheets("凭证管理").Cells(3, 6) = Sheets("数据库").Cells(Sheets("数据库").Cells(16, 4) - 1, 11)
    
29. Sheets("凭证管理").Cells(3, 13) = Sheets("数据库").Cells(Sheets("数据库").Cells(16, 4) - 1, 12) + 1
    
30. End If
    
31. 凭证清除
    
32. Application.ScreenUpdating = False
    
33. x = k: y = 5
    
34. Do Until .Cells(x, 8) = ""
    
35.     If .Cells(x, 7) <> "" Then
    
36.         摘要 = .Cells(x, 7)
    
37.     End If
    
38.     If Val(.Cells(x, 11)) <> 0 Or Val(.Cells(x, 12)) <> 0 Then
    
39.         pzkmkz = 1: Sheets("凭证管理").Cells(y, 2) = 摘要
    
40.         pzkmkz = 1: Sheets("凭证管理").Cells(y, 4) = .Cells(x, 8)
    
41.         pzkmkz = 1: Sheets("凭证管理").Cells(y, 10) = .Cells(x, 9)
    
42.         pzkmkz = 1: Sheets("凭证管理").Cells(y, 12) = .Cells(x, 11)
    
43.         pzkmkz = 1: Sheets("凭证管理").Cells(y, 13) = .Cells(x, 12)
    
44.         y = y + 1
    
45.     End If
    
46.     x = x + 1
    
47. Loop
    
48. 
    
49. Application.ScreenUpdating = True
    
50. x = k
    
51. Do Until .Cells(x, 8) = ""
    
52. If .Cells(x, 14) <> "" And (.Cells(x, 14) - .Cells(x, 13)) < .Cells(x, 12) Then
    
53. .Cells(x, 12) = .Cells(x, 14) - .Cells(x, 13)
    
54. ElseIf .Cells(x, 14) <> "" And (.Cells(x, 14) - .Cells(x, 13)) > .Cells(x, 12) _
    
55. And (.Cells(x, 14) - .Cells(x, 13)) * (2 / 3) < .Cells(x, 12) Then
    
56. .Cells(x, 12) = .Cells(x, 14) - .Cells(x, 13)
    
57. ElseIf .Cells(x, 14) <> "" And .Cells(x, 13) < .Cells(x, 14) Then
    
58. .Cells(x, 13) = .Cells(x, 13) + .Cells(x, 12)
    
59. If .Cells(x, 13) = .Cells(x, 14) Then
    
60. .Cells(x, 12) = ""
    
61. End If
    
62. End If
    
63. x = x + 1
    
64. Loop
    
65. End With
    
66. End If
    
67. End If
    
68. End If
    
69. End Sub

复制代码

xj.cpa

jilinge2 发表于 2016-2-4 08:22
王老师，请问下常用凭证那里能简单修改下代码吗？能否添加2个按钮（功能就是科目汇总表把《所有下级科目》 ...

非常感谢你对小管家的关爱，放在网上的只是简化版，在完全版中所有的功能都有的。
不过从编程角度讲，你的代码还可以更简单的。

jilinge2

xj.cpa 发表于 2016-2-4 09:35
非常感谢你对小管家的关爱，放在网上的只是简化版，在完全版中所有的功能都有的。
不过从编程角度讲，你 ...

请问下王老师 完全版在哪里能下载呀？

xj.cpa

jilinge2 发表于 2016-2-4 15:05
请问下王老师 完全版在哪里能下载呀？

完全版是需要安装的，没有放在网上。