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

 找回密码
 
查看: 12172|回复: 42

[VBA/VBS教程] 天远ET工具箱新功能介绍及源代码解读6——工作表重命名

[复制链接]

84

主题

58

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-2-28 16:30 |显示全部楼层
分享到: 新浪微博 腾讯微博
功能:批量重命名当前工作簿中的工作表! i5 H$ Z2 G" v( K4 C) c) w

8 e; P8 j" H/ D& _: m9 y功能演示:
# }/ y0 ^. U& |8 t( A# E
6 b: [: Q$ ^; j% O1 \, r. U0 F; L/ p9 ^+ q& @2 k* M  y
) |8 V& J2 U- H1 m# j1 a; Z

1 m7 o; \7 S3 s1 \7 W9 i
: K$ Z) V, _: y1 I; s; Z4 i% y" [
3 x& j3 L6 X& d. ~9 [1 [+ u- ^2 T7 R" B8 n

. P' i4 n1 M0 B- M& X7 ]& o, j: y3 [$ ]& Y, n
3 S0 B8 [3 k! h( W0 b& ?/ t; W7 e
- N. I9 t! z8 s. f) F
VBA源代码解读(附件中还提供VBS脚本):
3 I+ R% W4 d; t01 Public Sub RenameWorksheets(ByVal ShtStart As Integer, ByVal ShtEnd As Integer, ByVal StrStart As String, ByVal StrEnd As String, ByVal NumStart As Integer, ByVal Numstep As Integer) '批量工作表重命名7 J) Z% I2 b$ c/ t
02 On Error Resume Next. L6 U$ V) v& b1 c) E
03 Application.ScreenUpdating = False '关闭屏幕更新,加快速度( k/ [4 `% i/ H6 c* d/ O- M
04 Dim AcWss As Worksheets# q8 b1 h5 e; U7 f5 S% R; E( l
05 Set AcWss = Application.ActiveWorkbook.Worksheets8 G2 Z. r0 h: Y/ d0 B8 e
06 If ShtStart < 1 Then ShtStart = 13 G. N: B" g) m0 R
07 If ShtStart > AcWss.Count Then ShtStart = AcWss.Count9 }1 z1 |, H+ Z, `9 D
08 If ShtEnd < 1 Then ShtEnd = 1
7 a$ Z7 X1 t7 K4 q+ A09 If ShtEnd > AcWss.Count Then ShtEnd = AcWss.Count: `% ^1 z4 S" |; Y3 s3 O
10 If ShtStart > ShtEnd Then
+ T9 O# P5 p0 B/ @0 C11     Dim ShtTemp As Integer
7 B8 \" r! H. h( B9 O1 X12     ShtTemp = ShtStart
' ~  q# ^! S& J4 H, b13     ShtStart = ShtEnd
6 S, O9 h1 V4 E- g2 c+ O9 j! `: p1 r14     ShtEnd = ShtTemp
5 p0 {+ ?, d* Q) ^2 D7 \15 End If/ r" q9 D  r" G1 k6 X- n
16 If 0 = Numstep Then Numstep = 11 \, k2 g! H# g( @7 J
17 Dim i As Integer8 z  z  s. Z" S! W  Q' k8 w
18 For i = ShtStart To ShtEnd
1 H- G, E1 h1 ^5 ^" ^& s19     AcWss(i).Name = StrStart & NumStart & StrEnd
/ M$ e" i; O3 \3 g; A20     NumStart = NumStart + Numstep
$ x' r5 Q: r4 |% Q21 Next i' z! ^# B; q) P  H/ P" H% u
22 MsgBox "批量工作表重命名成功!", 0 + 64, "天远ET工具箱"
0 @0 v  c* Y9 s# k23 Application.ScreenUpdating = True* J% D* V0 s( @+ {; N$ M: E
24 End Sub$ z0 m# r, @) \
25 & x& c; v) T% K* i
26 Public Sub RenameWorksheetsSub() '批量工作表重命名# \& [+ C- @! M! O& O, V: J
27 On Error Resume Next
. z) a. L1 U4 u/ [  x  b! `! v( D28 Application.ScreenUpdating = False '关闭屏幕更新,加快速度
+ W$ W7 ]' B& E4 G" T7 f29 Dim AcWss As Worksheets$ w: J! e, i" q; [! N
30 Set AcWss = Application.ActiveWorkbook.Worksheets
" h. b& s" B  q0 y+ @' B31 Dim istr1, istr2, istr3, istr4, istr5, istr6, str As String8 f6 z7 u+ q1 L/ f6 a* R, H0 k! ~
32 str = "请输入起始工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"
( k) t; ?0 Z  G/ ~33 istr1 = InputBox(str, "天远ET工具箱", 1); o" _3 Y8 f1 z! p) M$ r0 Q
34 str = "请输入终止工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"
2 b) W, G$ [- g8 V/ G5 F2 O& v35 istr2 = InputBox(str, "天远ET工具箱", AcWss.Count)
6 H; u% i9 L+ J; w3 Y, c5 f, L36 str = "请输入工作表名称前缀(序号前)" & vbCrLf & vbCrLf & "允许为空"$ h4 a7 t5 |- o3 c7 B. M% r
37 istr3 = InputBox(str, "天远ET工具箱", "前缀")7 r( w) g9 B- J1 e
38 str = "请输入工作表名称后缀(序号后)" & vbCrLf & vbCrLf & "允许为空"6 X( `) x% f7 p& |8 ^+ W) n
39 istr4 = InputBox(str, "天远ET工具箱", "后缀")0 `/ s3 i9 g( z0 T
40 str = "请输入工作表名称起始序号" & vbCrLf & vbCrLf & "允许非正数"
* a7 a$ {. o0 _/ i9 E3 K9 f. o41 istr5 = InputBox(str, "天远ET工具箱", 1)( u9 M3 Q% ?% ^/ p% D4 P3 _. W" R
42 str = "请输入工作表名称序号步长" & vbCrLf & vbCrLf & "允许非0整数,为0时自动转换成1"
# T: p0 H- e, e9 Q  S43 istr6 = InputBox(str, "天远ET工具箱", 1)
6 D. X9 U/ f9 B  W4 ~- j44 Call RenameWorksheets(Int(istr1), Int(istr2), istr3, istr4, Int(istr5), Int(istr6))6 o3 U, D. ]3 k
45 Application.ScreenUpdating = True
8 G$ K$ ?0 |' j& @46 End Sub
: M- j+ Q, B9 t2 k9 z/ |1 d0 p: ~" A$ }/ b/ m

3 y2 V; \# I9 ?- l6 P6 H% H
' @2 Z2 @: B9 Q3 P/ b  Z
0 ?9 ^, c4 X8 s( u0 S# _1 c5 {附件:天远批量工作表重命名VBA版和VBS版(使用VBA版需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)
) R( A+ m: y- r) H4 |
游客,如果您要查看本帖隐藏内容请回复
1 i$ {2 }8 a( c1 E/ B
使用天远ET工具箱不需要VBA环境,天远ET工具箱即将加入批量工作表重命名功能,敬请期待。
3 T6 f+ U: ]2 q" N+ b/ [
$ s$ m+ Q8 @) J; K6 Q9 z6 {1 F$ R% u+ f

本帖子中包含更多资源

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

已有 5 人评分威望 收起 理由
翘尾的k + 17 WPS有你更精彩!
松风水月 + 20 很给力!
zhouyiran1@126.com + 18 赞一个!
1149737746 + 10 赞一个!
Chad + 10 赞一个!

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

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

971

主题

318

听众

27万

积分

管理员

Rank: 24Rank: 24Rank: 24Rank: 24Rank: 24Rank: 24

签到天数: 12 天

[LV.3]偶尔看看II

金币
38808
威望
897927
帖子
7588
精华
1

WPS粉丝团 勤奋版主奖 乐于助人奖 优秀会员奖 活跃会员奖 活动策划团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 超级版主勋章

发表于 2013-2-28 16:39 |显示全部楼层
不错,有需要的童鞋拿去了~~~
你是WPS的粉丝吗?详情请看:http://bbs.wps.cn/thread-22336260-1-1.html
回复

使用道具 举报

3

主题

0

听众

29

积分

LV.1

Rank: 1

签到天数: 2 天

[LV.1]初来乍到

金币
1
威望
13
帖子
39
精华
0
发表于 2013-3-2 16:41 |显示全部楼层
想要一个源码
! E: e" s" J4 [( Y2 `( s
回复

使用道具 举报

9

主题

22

听众

1万

积分

测试体验团员

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

签到天数: 1097 天

[LV.10]以坛为家III

金币
2069
威望
25696
帖子
6101
精华
0

优秀会员奖 活跃会员奖 乐于助人奖 测试体验团

发表于 2013-3-2 17:31 |显示全部楼层
赞一个                  
回复

使用道具 举报

84

主题

58

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-3-2 19:01 |显示全部楼层
zhangop9 发表于 2013-3-2 16:41 1 Q2 H: k) Y4 Z
想要一个源码

4 n# v3 x( n: g  w' D源码在附件
回复

使用道具 举报

153

主题

109

听众

1万

积分

解答支持团长

老菜鸟

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

签到天数: 240 天

[LV.8]以坛为家I

金币
1254
威望
25965
帖子
10314
精华
1

活跃会员奖 解答支持团 测试体验团 乐于助人奖 优秀会员奖

发表于 2013-3-2 20:45 |显示全部楼层
继续学习!收藏+顶帖+送分,老夫的三件套奉上!
回复

使用道具 举报

23

主题

1

听众

3491

积分

LV.10

Rank: 10Rank: 10Rank: 10

签到天数: 160 天

[LV.7]常住居民III

金币
906
威望
9116
帖子
1086
精华
0
发表于 2013-3-2 21:07 |显示全部楼层
顶一个!!
回复

使用道具 举报

84

主题

58

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-3-2 21:11 |显示全部楼层
zhouyiran1@126.com 发表于 2013-3-2 20:45
. j/ H8 u) s7 }$ d4 h/ m9 B- w继续学习!收藏+顶帖+送分,老夫的三件套奉上!
: P- [5 c5 U2 i% i6 _: k
收下了三件套
回复

使用道具 举报

19

主题

104

听众

5338

积分

技术分享团长

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

签到天数: 5 天

[LV.2]偶尔看看I

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

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

发表于 2013-3-4 10:55 |显示全部楼层
前来学习,感谢天远!. {) E2 t% u2 D5 S2 ~' h# T
批量工作表重命名,太给力了!{:soso_e183:}
回复

使用道具 举报

46

主题

0

听众

588

积分

LV.5

Rank: 5Rank: 5

该用户从未签到

金币
90
威望
1179
帖子
219
精华
0
发表于 2013-3-11 14:18 |显示全部楼层
批量工作表重命名,太给力了!
回复

使用道具 举报

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

快速回帖:

fastpost

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

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

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部