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

 找回密码
 
查看: 15439|回复: 40

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

  [复制链接]

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-11-15 13:51 |显示全部楼层
分享到: 新浪微博 腾讯微博
论坛里有很多高手都讲过如何生成工资条,现在天远也加入这个阵营来喽。, {- d3 G# t: x2 f
今天带来的是一个个人认为比较强大的VBA过程,它能做到一键自动生成工资条(成绩条),而且支持选择每一条工资条(成绩条)的行数(比较常见的是两行或者三行)。# ?) c& S6 N9 m6 w+ ~
好了,工资条(成绩条)这个事情大家都比较熟悉,天远也没有什么可以多说的,直接看效果图吧,然后送上代码和文档:1 F& f( C0 x( n) U

* p  t3 @$ g; [. G$ w+ q# X( P' I1 k& Z* Z

' j9 X+ b/ p% {5 F' s5 q/ {# f9 o& K$ r8 z
- k0 H% @( \" s; z, M% l- W& P

  m3 P! ~! K8 \6 B
  1. Public Sub 生成工资条A() '每条两行/ t+ _& N' d( T) A, I/ X/ M
  2. Call 自动生成工资条A(2)
    6 i- ?; y9 U: M' j
  3. End Sub
    ( A9 N6 Z' T( f* X, ?# R
  4. Public Sub 生成工资条B() '每条三行
    ; P- O; P0 n# C4 k5 w/ g+ e! \
  5. Call 自动生成工资条A(3)3 B# _- G" Q3 u* H" V( o8 z
  6. End Sub
    : f9 a3 ?& m7 T% e2 I& X
  7. Public Sub 生成工资条C() '每条多行
    2 K4 e0 V$ N) o, m6 E2 x
  8. Call 自动生成工资条A(0)
    " |. i! k9 H- w
  9. End Sub
    6 Q" J  L& s; p8 Y
  10. Public Sub 自动生成工资条A(Optional ByVal myRow As Integer = 0)  \, Z- l1 b/ @& X$ b  P* ^- [2 t
  11. On Error GoTo myErr
    5 {5 v3 ?) L& t; ]! P+ g
  12. Application.ScreenUpdating = False '关闭屏幕更新,加快速度5 d" E$ S: \5 X' W& R
  13. 'On Error Resume Next6 @- U) l% H( ^
  14. If TypeName(Selection) <> "Range" Then GoTo myExit ' 选择对象不是单元格则退出
    ; B6 H# E  C% x7 Y; e" V
  15. If myRow = 0 Then2 j" r! B' C; o/ Y
  16. myRow = InputBox("请输入每个一工资条的行数:" & vbCrLf & "(输入的数据要大于等于2,否则不执行操作)", "天远自动生成工资条", 2) ' 2, , , , , 1)
    4 p' W: n% ?$ A6 w* M
  17. If Val(myRow) < 2 Then3 Y5 ~7 T4 w% a0 B# P9 E6 Z+ W; F
  18. MsgBox "对不起,输入的数据要大于等于2!", 0 + 64, "天远自动生成工资条"
    5 T8 O$ r5 f9 ?6 `
  19. GoTo myExit
    7 r7 I/ g. r, m- o
  20. End If
    ! b: ?9 Y/ {; Q0 Z: w5 M
  21. End If
    1 M1 R$ L2 Y; I7 x8 p
  22. If Selection.Rows.Count < myRow Then7 l, O3 m( m) V$ s3 u+ U. N4 M1 K
  23. MsgBox "至少需要" & myRow & "行数据!", 0 + 64, "天远自动生成工资条"
    5 }) U8 S8 ^- e9 @! h. @/ j
  24. GoTo myExit
    $ R( w" ^2 e5 i: X7 E
  25. End If; K" W  \- E* g: R
  26. Dim rngg As Range2 P" O: [# T0 J& {' o2 S
  27. Set rngg = Selection, l% a% b& D/ a% @

  28. + g7 R; w" K6 P5 e* I; p2 Z
  29. Dim r, rNew As Long
    ( p5 I0 y+ w! K8 E% T
  30. rNew = 1+ d" M3 B  X5 }( d- |

  31. 5 n* b% D  e7 L( r" J9 g+ I
  32. Dim ShtOldOne, ShtNewOne As Worksheet
    / M: I7 _, K4 \( X+ w0 W% w# X
  33. Set ShtOldOne = Worksheets(1) '取得当前第一个表
    , _1 d2 }9 r9 t* n6 Z
  34. Set ShtNewOne = Worksheets.Add(ShtOldOne)0 N3 H8 x3 ~$ C0 Z! h
  35. Set ShtOldOne = Nothing' K8 r0 \' Y/ w
  36. 'ShtNewOne.Name = "自动工资条"
    3 w5 E4 ?% f/ j4 V, D5 a
  37. ShtNewOne.Visible = True9 m2 ?8 h: y6 z

  38. : c  l7 e3 y! i. Z4 ?
  39. For r = myRow To rngg.Rows.Count
    9 E) }! a: Q/ C
  40. rngg.Cells(1, 1).Resize(myRow - 1, rngg.Columns.Count).Copy2 P1 T9 A/ }2 O2 R/ d( a4 W! P4 C
  41. ShtNewOne.Cells(rNew, 1).Resize(myRow - 1, rngg.Columns.Count).PasteSpecial
    9 f9 _% q5 l* l; @
  42. rngg.Cells(r, 1).Resize(1, rngg.Columns.Count).Copy: f1 z* t- ^9 Z: i- Q) w# M( C
  43. ShtNewOne.Cells(rNew + myRow - 1, 1).Resize(1, rngg.Columns.Count).PasteSpecial0 ]1 \! \3 m9 c- O4 b, K+ `3 c
  44. rNew = rNew + myRow + 1" @, L  s# g$ s; Z
  45. Next r
    $ C; ^. I4 Z. @

  46. 6 z% K) ^" C0 x3 f  ]. ]
  47. Set rngg = Nothing
    $ W% [% o- G' y7 }! d
  48. With ShtNewOne
    $ [$ w& Q* Y+ r9 S- [: M7 y7 _8 L
  49. .Hyperlinks.Add .Cells(rNew, 1), "http://bbs.wps.cn/thread-22349095-1-1.html", "", "访问天远ET工具箱", "本工资条由天远ET工具箱自动生成"$ A6 @  i$ s; L" A1 z. ]
  50. End With+ `5 p1 i1 l8 Z; j% Z% ~
  51. ShtNewOne.Activate
    ) r' @+ Q, E0 [: o7 h9 P$ q
  52. Set ShtNewOne = Nothing0 n3 j  e. Z2 k) Z7 U) u; M
  53. myErr:' o6 q9 B! l' ?$ {
  54. myExit:6 Q9 F# o! r! q; T4 M) k6 n
  55. Application.ScreenUpdating = True '关闭屏幕更新,加快速度+ ?, w8 p3 Y$ p  n
  56. End Sub
复制代码
相关文档:4 o6 @- u& g) O8 M( k) w9 Y
(使用本文档需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)
4 V0 j( p; _- {6 |( R# p7 V7 _" |, y; U5 P& p

* r9 Z, J5 G! e6 S由于部分技术上的原因,目前这个功能还没有集成到天远ET工具箱,不过,很快会有的,不会让大家等太久!
! o' V* b  F9 R; y8 Z. J7 Y8 w! ~: f4 A

本帖子中包含更多资源

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

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

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

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

19

主题

37

听众

2189

积分

LV.8

Rank: 8Rank: 8

该用户从未签到

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

使用道具 举报

53

主题

60

听众

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

主题

111

听众

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 |显示全部楼层
我是新手;什么是天远工具箱;# u8 o# Y+ |6 q+ s1 r
另外选择行数和生成结果有什么区别?
回复

使用道具 举报

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

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛 ( 粤公网安备 44049102496073号 粤ICP备13015957号-1   

GMT+8, 2018-1-19 17:57

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部