最新WPS办公软件学习教程_免费企业办公软件下载_金山WPS Office官网论坛

 找回密码
 
查看: 14738|回复: 39

[VBA/VBS教程] 利用VBA一键自动生成工资条(成绩条)

  [复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
984
威望
8204
帖子
842
精华
3

WPS粉丝团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 最佳教程奖 优秀会员奖

发表于 2012-11-15 13:51 |显示全部楼层
分享到: 新浪微博 腾讯微博
论坛里有很多高手都讲过如何生成工资条,现在天远也加入这个阵营来喽。
7 T) a3 U1 |) w/ R2 e今天带来的是一个个人认为比较强大的VBA过程,它能做到一键自动生成工资条(成绩条),而且支持选择每一条工资条(成绩条)的行数(比较常见的是两行或者三行)。
0 m$ d+ T( j5 [/ j1 p4 L好了,工资条(成绩条)这个事情大家都比较熟悉,天远也没有什么可以多说的,直接看效果图吧,然后送上代码和文档:8 M1 b( h7 p2 H( w& n; y- z
% _- Y& @/ ~# M* f+ F+ d" G6 Q7 D
1 W1 O9 ]: T  E! h3 u6 g! E' M; s. I

0 S! G9 v3 i) |" B0 T" S. P( z. X+ f& A5 v( R4 y. Z

$ d; S6 X% f- ]0 o$ X+ S, l! ?. B  Y* \3 g% i( C
  1. Public Sub 生成工资条A() '每条两行! b7 ?7 [0 P. a/ r5 t0 r* ~
  2. Call 自动生成工资条A(2)9 ~$ L; {3 U8 q- r' Q  f* g: U
  3. End Sub
    0 @# Y1 i9 a, h! U
  4. Public Sub 生成工资条B() '每条三行
    ; i1 g- {. L4 U4 E: H$ i
  5. Call 自动生成工资条A(3)
    2 k+ Z1 m. }/ u4 X
  6. End Sub: y" O1 W2 A) a0 }; U7 s
  7. Public Sub 生成工资条C() '每条多行) r' g6 ~* S: t0 }8 B% s/ {
  8. Call 自动生成工资条A(0)8 x& t. C( u. \+ H+ f( R& h0 I
  9. End Sub8 k1 @' A$ q( z  W$ x3 t
  10. Public Sub 自动生成工资条A(Optional ByVal myRow As Integer = 0)
    . ~) ]0 X" P' @4 f
  11. On Error GoTo myErr6 |" Q6 ?1 X# F( G4 t
  12. Application.ScreenUpdating = False '关闭屏幕更新,加快速度
    * O8 l& L  }$ `0 d
  13. 'On Error Resume Next
    7 q- B- w2 c  m( j7 R6 k7 H# j* ?4 V) o
  14. If TypeName(Selection) <> "Range" Then GoTo myExit ' 选择对象不是单元格则退出
    $ L$ Q3 e6 Z! N" \8 _% U: Y+ x
  15. If myRow = 0 Then5 }( a9 ~$ d, P& C) q
  16. myRow = InputBox("请输入每个一工资条的行数:" & vbCrLf & "(输入的数据要大于等于2,否则不执行操作)", "天远自动生成工资条", 2) ' 2, , , , , 1)
    , {+ l! x' W7 ~/ q, m7 k% _
  17. If Val(myRow) < 2 Then5 T6 I4 J1 y  E/ d+ W5 [3 Y0 b& |( e9 t
  18. MsgBox "对不起,输入的数据要大于等于2!", 0 + 64, "天远自动生成工资条"
    2 b7 U7 m" D- g# ?# t7 L8 W
  19. GoTo myExit
    / N0 A* Z! T* r) D* {; }
  20. End If% j( a2 q. `5 G& H5 J2 ~
  21. End If
    / ?1 H! \- _3 [
  22. If Selection.Rows.Count < myRow Then# u9 E4 l& j; ^- ^3 I* N9 K1 ^
  23. MsgBox "至少需要" & myRow & "行数据!", 0 + 64, "天远自动生成工资条"" R. j* {' p$ V0 `6 A  r
  24. GoTo myExit
    ' p2 F  u" I* x) p
  25. End If
    7 a. o) B' _( |: A8 [+ r
  26. Dim rngg As Range
    : L- \& M, U" E7 E7 X! T
  27. Set rngg = Selection3 b+ \6 ?1 [' H/ m  U5 G& j
  28. ; |& d8 m1 `7 n4 G# q" N
  29. Dim r, rNew As Long+ \8 i: O  r: n" r/ Q* b: [
  30. rNew = 1
    ! Y/ J( k& W3 C$ W3 w4 Z4 f

  31. 6 D% a' C+ _6 ?; X" Y5 c
  32. Dim ShtOldOne, ShtNewOne As Worksheet( x( |8 R: }) u+ K
  33. Set ShtOldOne = Worksheets(1) '取得当前第一个表
    # Z3 \! G8 M6 `! D
  34. Set ShtNewOne = Worksheets.Add(ShtOldOne)
    / d/ W5 u" O* u; S. a7 c8 q  S
  35. Set ShtOldOne = Nothing
    9 x( M4 M- z6 w' u/ D. @. W
  36. 'ShtNewOne.Name = "自动工资条"" G( e8 L! v) d/ l: i
  37. ShtNewOne.Visible = True; U% N4 n+ a# W; ]  M. U7 T: [8 ]

  38. 9 _- a( Y2 s% e, d
  39. For r = myRow To rngg.Rows.Count1 [# H$ q& w+ Z3 O% t
  40. rngg.Cells(1, 1).Resize(myRow - 1, rngg.Columns.Count).Copy% e4 p* g" f5 B2 B0 H0 E
  41. ShtNewOne.Cells(rNew, 1).Resize(myRow - 1, rngg.Columns.Count).PasteSpecial
    8 D, I1 V3 s0 n' c& S  Z0 ?) D0 c% {) p
  42. rngg.Cells(r, 1).Resize(1, rngg.Columns.Count).Copy1 `: |0 ^$ n* \" S/ ~5 P' l
  43. ShtNewOne.Cells(rNew + myRow - 1, 1).Resize(1, rngg.Columns.Count).PasteSpecial
    2 |  z, K2 W3 G" g
  44. rNew = rNew + myRow + 1
    ( m& i: H' Y8 a' T, l3 Z  _, R
  45. Next r
    - @# E/ x) J9 j( O7 s5 @

  46. . N& [. a, w) R( @* U% Y
  47. Set rngg = Nothing2 ^8 X  q& s9 P* n
  48. With ShtNewOne
    , g9 t& D2 q3 B+ l4 `! d
  49. .Hyperlinks.Add .Cells(rNew, 1), "http://bbs.wps.cn/thread-22349095-1-1.html", "", "访问天远ET工具箱", "本工资条由天远ET工具箱自动生成"
    # l% L  w2 N$ ?6 F% q
  50. End With3 }3 I5 q" l9 S
  51. ShtNewOne.Activate! M1 m: l1 c. l% [4 G
  52. Set ShtNewOne = Nothing
    0 S3 [) U' @1 W6 \& c
  53. myErr:/ Z$ g9 y+ ^& n) C
  54. myExit:3 ?* R+ }- o2 i  Y4 U6 i8 v* n
  55. Application.ScreenUpdating = True '关闭屏幕更新,加快速度9 L, i& d. G/ |* P
  56. End Sub
复制代码
相关文档:4 i$ w; H4 d0 k  s% Z
(使用本文档需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)" ?- P3 B* `) \( h0 l/ O: G- |7 n
" S7 b' C/ Z1 T
$ d1 _# C8 ~0 o, ^9 ^# y% K6 A
由于部分技术上的原因,目前这个功能还没有集成到天远ET工具箱,不过,很快会有的,不会让大家等太久!
/ c4 ~. ?( |5 q8 i; I" P3 {& b9 F4 Y

本帖子中包含更多资源

您需要 登录 才可以下载或查看,

已有 2 人评分威望 收起 理由
松风水月 + 15 天远工具箱越来越强大了!
wqs099207@163.com + 15 很给力!真的也很方便,谢谢楼主的分享,学.

总评分: 威望 + 30   查看全部评分

热爱分享和学习。希望WPS论坛越办越好,WPS软件越做越好。也希望能在这里交到更多志同道合的朋友。我的邮箱:ypr@yprnet.com
我在WPS论坛上的教程帖子合集: http://blog.yprnet.com/wps

19

主题

36

听众

2189

积分

LV.8

Rank: 8Rank: 8

该用户从未签到

金币
3466
威望
5612
帖子
637
精华
0
发表于 2012-11-15 13:56 |显示全部楼层
好给力啊,真的不错,学习了!!谢谢天远的分享!
回复

使用道具 举报

53

主题

59

听众

6715

积分

版主

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 126 天

[LV.7]常住居民III

金币
634
威望
13773
帖子
3973
精华
2

WPS粉丝团 技术分享团 乐于助人奖 技巧教程分享达人 优秀会员奖 活跃会员奖 测试体验团 版主勋章 勤奋版主奖 最佳教程奖 测试体验官 优秀模板奖

发表于 2012-11-15 16:45 |显示全部楼层
{:1_14:}等待集成在一起的时候

点击了解最新动态:【轩少】__实用教程索引(2015-9-6更新)
http://bbs.wps.cn/forum.php?mod= ... amp;fromuid=2404273
回复

使用道具 举报

19

主题

106

听众

5338

积分

技术分享团长

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 5 天

[LV.2]偶尔看看I

金币
5316
威望
11825
帖子
2334
精华
1

WPS粉丝团 荣誉版主奖 活跃会员奖 技术分享团 解答支持团 重阳节勋章

发表于 2012-11-15 16:55 |显示全部楼层
真的感谢天远,天远工具箱真是越来越强大了!
回复

使用道具 举报

26

主题

1

听众

250

积分

LV.4

Rank: 4

签到天数: 5 天

[LV.2]偶尔看看I

金币
22
威望
494
帖子
130
精华
0
发表于 2013-4-13 22:40 |显示全部楼层
太给力了
回复

使用道具 举报

2

主题

0

听众

412

积分

LV.5

Rank: 5Rank: 5

该用户从未签到

金币
113
威望
1099
帖子
130
精华
0
发表于 2013-5-15 17:22 |显示全部楼层
感觉好复杂啊,希望能学会!
回复

使用道具 举报

0

主题

0

听众

2

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
0
帖子
0
精华
0
发表于 2013-5-25 16:17 |显示全部楼层
不能下啊
回复

使用道具 举报

0

主题

0

听众

2

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
0
帖子
0
精华
0
发表于 2013-5-25 16:39 |显示全部楼层
很受教,我以后一定加强学习
回复

使用道具 举报

2

主题

0

听众

6

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
10
帖子
5
精华
0
发表于 2014-4-25 15:58 |显示全部楼层
下载了天远工具可是装 不上去
回复

使用道具 举报

8

主题

1

听众

194

积分

LV.3

Rank: 3Rank: 3

签到天数: 1 天

[LV.1]初来乍到

金币
5
威望
493
帖子
54
精华
0
发表于 2014-5-8 08:14 |显示全部楼层
我是新手;什么是天远工具箱;
1 L/ H8 z6 A& L  a* ?另外选择行数和生成结果有什么区别?
回复

使用道具 举报

*滑动验证:
您需要登录后才可以回帖 登录 | 更多账号登录:

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛     

GMT+8, 2017-11-18 14:26

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部