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

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

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

  [复制链接]

84

主题

58

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-11-15 13:51 |显示全部楼层
分享到: 新浪微博 腾讯微博
论坛里有很多高手都讲过如何生成工资条,现在天远也加入这个阵营来喽。
8 [2 s  M& E; V. _2 V7 s& j今天带来的是一个个人认为比较强大的VBA过程,它能做到一键自动生成工资条(成绩条),而且支持选择每一条工资条(成绩条)的行数(比较常见的是两行或者三行)。
/ T/ l* [; H; h6 E好了,工资条(成绩条)这个事情大家都比较熟悉,天远也没有什么可以多说的,直接看效果图吧,然后送上代码和文档:2 W& ]# u: @) v
, C) t7 t. f7 P1 C1 d, ^

/ d1 W$ p1 Q; q- e5 L+ _6 u. u* o  L
; F8 ?* Q9 `0 Z2 d! n" b

# O! Z' T! [9 l  S' U5 ]* {0 v' n5 T6 E: Y4 S0 R6 ^& _
  1. Public Sub 生成工资条A() '每条两行6 s. u" `, j: L# @$ h: L/ f
  2. Call 自动生成工资条A(2)- l1 k6 s5 J4 H' x5 v3 j$ q
  3. End Sub
    + {' ^0 f$ i! L: g
  4. Public Sub 生成工资条B() '每条三行5 G! c. y9 _2 v& N4 X
  5. Call 自动生成工资条A(3)0 J4 l2 M* D/ f: }' D: d' o0 r% D
  6. End Sub$ D/ }( |. o2 i
  7. Public Sub 生成工资条C() '每条多行( j. X# [7 E& U9 A( o
  8. Call 自动生成工资条A(0)
    # j+ @/ m1 p3 x9 D5 h
  9. End Sub. t- [# i. S  w; r" h* d
  10. Public Sub 自动生成工资条A(Optional ByVal myRow As Integer = 0)
      E, W$ a( V8 P3 \, P* I, e( ^8 j
  11. On Error GoTo myErr- P/ K6 m; E: {' q* f
  12. Application.ScreenUpdating = False '关闭屏幕更新,加快速度
    4 u/ z* v0 h2 l4 H2 Z! Z
  13. 'On Error Resume Next9 y$ {; S  w  X2 N/ W8 r+ c
  14. If TypeName(Selection) <> "Range" Then GoTo myExit ' 选择对象不是单元格则退出
    - v/ z6 v$ q' [% K; r
  15. If myRow = 0 Then
    ) t! q1 O* @4 P7 ~
  16. myRow = InputBox("请输入每个一工资条的行数:" & vbCrLf & "(输入的数据要大于等于2,否则不执行操作)", "天远自动生成工资条", 2) ' 2, , , , , 1)
    4 p: W& A: n% n( f* T
  17. If Val(myRow) < 2 Then, {. C  i; d- C" ~# F
  18. MsgBox "对不起,输入的数据要大于等于2!", 0 + 64, "天远自动生成工资条"
    # d2 B9 r) Y/ i& F% X0 R- z2 s+ i  {
  19. GoTo myExit, ]+ r' r) O3 b- ~( W) a# u
  20. End If
    ' E& D0 G( {3 `# p0 V$ p2 A. q8 v
  21. End If. b' s" y! e% a3 ^$ E$ i3 ~
  22. If Selection.Rows.Count < myRow Then2 V) X6 J: y- R6 S( M* a9 ^  y: w" v
  23. MsgBox "至少需要" & myRow & "行数据!", 0 + 64, "天远自动生成工资条"
    / I# q" S: P6 e
  24. GoTo myExit
    9 g- V9 |5 o- ]* X. y0 K% r
  25. End If
    % q9 B% A7 q# E7 g) P
  26. Dim rngg As Range
    % b, [0 Q( }5 |
  27. Set rngg = Selection" i  Z, ^4 H/ @, t; C+ {1 Z+ e/ v
  28. - c+ D# u- n5 d, M6 Z
  29. Dim r, rNew As Long
    : ^  f5 v6 {& ~* d& y1 |
  30. rNew = 1) R% @) @; M* B! `0 D) ]
  31. 3 J- G+ f9 B. {
  32. Dim ShtOldOne, ShtNewOne As Worksheet
    / b4 n$ j; ^  h* \" t* j3 m% z, g
  33. Set ShtOldOne = Worksheets(1) '取得当前第一个表
    9 ]! P: J( h7 W; V. f5 y
  34. Set ShtNewOne = Worksheets.Add(ShtOldOne)1 M& P. H* R$ \$ {/ A  D6 ]) V
  35. Set ShtOldOne = Nothing
    9 X1 h6 ]: H% R. e, T4 L
  36. 'ShtNewOne.Name = "自动工资条"
    / p) g5 z4 {" G; K! r! r1 Q: i3 d3 h( p
  37. ShtNewOne.Visible = True
      M$ d5 }4 k6 ^/ f. ~- x0 {- C
  38. ( W4 i* ]0 @) e; S  T
  39. For r = myRow To rngg.Rows.Count6 X( i( ]: p6 E7 A; b# ]7 R' n
  40. rngg.Cells(1, 1).Resize(myRow - 1, rngg.Columns.Count).Copy
    9 W7 s' M- k2 G5 B; V
  41. ShtNewOne.Cells(rNew, 1).Resize(myRow - 1, rngg.Columns.Count).PasteSpecial' f0 c1 v4 F/ F4 r0 R0 A
  42. rngg.Cells(r, 1).Resize(1, rngg.Columns.Count).Copy
    6 M1 d1 i3 F% K
  43. ShtNewOne.Cells(rNew + myRow - 1, 1).Resize(1, rngg.Columns.Count).PasteSpecial3 L% O  t. g- A
  44. rNew = rNew + myRow + 1
    ; Y) D! C* q! v( [1 {5 a5 n; r( ?
  45. Next r
    # U) h% L( j/ Y4 Z6 p4 n
  46. - n, C) `* j! U
  47. Set rngg = Nothing1 Z: v/ w1 Z0 U, G
  48. With ShtNewOne7 S8 {5 C1 }3 Q3 r) r+ t
  49. .Hyperlinks.Add .Cells(rNew, 1), "http://bbs.wps.cn/thread-22349095-1-1.html", "", "访问天远ET工具箱", "本工资条由天远ET工具箱自动生成"
    ) F( D2 i5 H# ^9 c% [: W
  50. End With
    $ B7 O2 L' F% R( A
  51. ShtNewOne.Activate
    * _7 Y5 z8 X; M5 {$ L
  52. Set ShtNewOne = Nothing
    8 ^$ k8 a+ ?+ d. `  u+ U
  53. myErr:
    9 p9 S- T2 Y/ g! L
  54. myExit:
    8 f- n" u6 L8 `2 e- s- }& c
  55. Application.ScreenUpdating = True '关闭屏幕更新,加快速度* b7 V1 ]5 ]) ^/ o  a+ E9 ^  w. F
  56. End Sub
复制代码
相关文档:
; E- L3 j0 ?& b( S; W. ](使用本文档需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)( z9 N8 z/ {) A. Y+ ?6 ^" e3 a
8 T! v" S' K; j2 ?+ O
4 g0 d) ?  [) q: H! e! ~
由于部分技术上的原因,目前这个功能还没有集成到天远ET工具箱,不过,很快会有的,不会让大家等太久!
. M1 D3 E: g! D3 B
7 @, K+ r( E8 v) P/ E( q

本帖子中包含更多资源

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

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

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

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

19

主题

35

听众

2189

积分

LV.8

Rank: 8Rank: 8

该用户从未签到

金币
3449
威望
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

主题

104

听众

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 |显示全部楼层
我是新手;什么是天远工具箱;
8 J% i9 }2 R* I/ |* r! B5 [另外选择行数和生成结果有什么区别?
回复

使用道具 举报

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

快速回帖:

fastpost

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

GMT+8, 2017-9-22 01:35

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部