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

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

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

[复制链接]

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-2-28 16:30 |显示全部楼层
分享到: 新浪微博 腾讯微博
功能:批量重命名当前工作簿中的工作表
& u$ l# q$ C' w  u# h7 e3 X  q
: T1 t( r, J2 s功能演示:
9 O$ ]* V; X0 O& w! O0 Q3 {! d* j, b1 U0 U; T0 L: {+ W
, O" u0 ]; W, U3 f
0 I/ D4 u( e0 }: ^" T, O$ _# b. y  m/ T! g

9 Z, J7 H' D% J; S0 v
/ O: N4 v  v* `/ ^3 z: N
  G5 x9 O* l) t2 i' K) I0 w% e
: I8 c+ A5 r- @5 Z9 e6 @7 h
0 |/ M0 c+ f$ Z& f
: C; m0 M  Z% c6 [9 ~# j0 D0 m8 Q1 H- w0 P  U
- o( M# Z- K+ ^+ C2 I
VBA源代码解读(附件中还提供VBS脚本):1 d4 i0 d% o! f
01 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 L7 V- H$ a5 s, q3 g
02 On Error Resume Next
+ G8 S7 i- z9 z0 ]% G" P2 Z5 R+ D: ^$ k03 Application.ScreenUpdating = False '关闭屏幕更新,加快速度
( Y8 I% E. {/ f6 N7 H04 Dim AcWss As Worksheets
7 J% G6 n+ M- @, n4 g5 U05 Set AcWss = Application.ActiveWorkbook.Worksheets
) _" j! l9 o% g9 {* U06 If ShtStart < 1 Then ShtStart = 1
% _! B7 F+ X* Q1 Q3 y0 U8 a9 p07 If ShtStart > AcWss.Count Then ShtStart = AcWss.Count# B: [: f* E" w/ I& o
08 If ShtEnd < 1 Then ShtEnd = 1
. s0 i& i/ b1 R2 ?; u09 If ShtEnd > AcWss.Count Then ShtEnd = AcWss.Count6 P; n6 Q" {# {! N) X. }" f. ?& Z
10 If ShtStart > ShtEnd Then
! }5 W7 p* B( i: G3 M) X11     Dim ShtTemp As Integer
* p" n1 v& r2 g: h4 [2 q12     ShtTemp = ShtStart3 \. h$ i6 P! ?6 k7 J! q
13     ShtStart = ShtEnd
! Q4 p0 X+ Z: Z" S2 g& _' |14     ShtEnd = ShtTemp
1 e7 |0 ~$ B$ j' t, e9 ~* i* i15 End If
7 e. W% h! m' D16 If 0 = Numstep Then Numstep = 1
* {% C  Z% u1 |17 Dim i As Integer, f8 \) t6 L8 l$ P; V; H# w4 M
18 For i = ShtStart To ShtEnd
7 y" N7 C3 Y$ G' J% M8 w8 d/ {19     AcWss(i).Name = StrStart & NumStart & StrEnd7 e, G% _/ b% z5 g3 e
20     NumStart = NumStart + Numstep* M2 A& S% f7 s' Y' X9 E! |
21 Next i6 u* b$ B% D2 b7 q
22 MsgBox "批量工作表重命名成功!", 0 + 64, "天远ET工具箱"
7 R- P2 t7 A0 e  D1 z- k# t4 y: t! h- Y23 Application.ScreenUpdating = True$ E5 U- m+ [3 ~1 z* \$ u
24 End Sub' u! K% F% q: }# l% u, x& P* H
25 - |- d2 A1 D1 Y0 S+ E
26 Public Sub RenameWorksheetsSub() '批量工作表重命名$ _' h5 x) t8 W% X8 f
27 On Error Resume Next6 A' m: D  c1 J8 o4 i) D
28 Application.ScreenUpdating = False '关闭屏幕更新,加快速度
) Z! h' r: v: T  c29 Dim AcWss As Worksheets
! R, c- {. g* F$ f# h' q30 Set AcWss = Application.ActiveWorkbook.Worksheets
& a" R  a9 L5 A7 P' ^( a+ _4 p2 a+ f31 Dim istr1, istr2, istr3, istr4, istr5, istr6, str As String
2 E# U: Y8 f% J0 R: X, A32 str = "请输入起始工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"! u: ?: f/ X# U
33 istr1 = InputBox(str, "天远ET工具箱", 1)4 ~& _  q9 b! [% ]
34 str = "请输入终止工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"
* i( o& \  |9 n7 M5 f" e' E35 istr2 = InputBox(str, "天远ET工具箱", AcWss.Count)! h4 k" d$ b& V) z( x( T3 E0 \+ I
36 str = "请输入工作表名称前缀(序号前)" & vbCrLf & vbCrLf & "允许为空"# ?3 I  F3 v0 v/ z- y; j5 y- F* H
37 istr3 = InputBox(str, "天远ET工具箱", "前缀")* F& Z9 S; W" V) v: Q1 g! p
38 str = "请输入工作表名称后缀(序号后)" & vbCrLf & vbCrLf & "允许为空"5 m! t% |* n4 M2 v
39 istr4 = InputBox(str, "天远ET工具箱", "后缀")
2 t6 u0 j8 c; X4 k" K40 str = "请输入工作表名称起始序号" & vbCrLf & vbCrLf & "允许非正数"
4 f$ u8 D; v; f' w! ], X41 istr5 = InputBox(str, "天远ET工具箱", 1)
9 e4 D: r! k% u1 w+ W" q42 str = "请输入工作表名称序号步长" & vbCrLf & vbCrLf & "允许非0整数,为0时自动转换成1"
1 O2 ^! G& R0 d5 z: g% b5 L43 istr6 = InputBox(str, "天远ET工具箱", 1)0 t- z% H# z$ w1 D( C0 y* W
44 Call RenameWorksheets(Int(istr1), Int(istr2), istr3, istr4, Int(istr5), Int(istr6))
8 n' |8 m: a9 x! D+ W" v, a45 Application.ScreenUpdating = True4 M* N% T& Z/ [7 B0 j
46 End Sub
! K1 a- l% ?0 A  K& ^
# E& b. M2 O* s

- k" ?: N' W' N8 k: L. U* L0 ^7 v+ f7 k* a
+ r2 m  i1 ~& L) `
附件:天远批量工作表重命名VBA版和VBS版(使用VBA版需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)
' E4 l# M; T+ S
游客,如果您要查看本帖隐藏内容请回复
/ @5 X' {! w$ H* I' x: ^
使用天远ET工具箱不需要VBA环境,天远ET工具箱即将加入批量工作表重命名功能,敬请期待。% D1 T8 X1 P( e; m* v, j

& l; P2 p' N$ s
9 k- \& M  K# w

本帖子中包含更多资源

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

已有 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

主题

319

听众

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

听众

30

积分

LV.1

Rank: 1

签到天数: 2 天

[LV.1]初来乍到

金币
1
威望
12
帖子
40
精华
0
发表于 2013-3-2 16:41 |显示全部楼层
想要一个源码$ X6 S; r1 c& d" \' Z- u) w% G
回复

使用道具 举报

9

主题

22

听众

1万

积分

测试体验团员

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

签到天数: 1204 天

[LV.10]以坛为家III

金币
2176
威望
26691
帖子
6217
精华
0

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

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

使用道具 举报

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-3-2 19:01 |显示全部楼层
zhangop9 发表于 2013-3-2 16:41 # e% E+ u2 j. B- u& O7 g1 U/ R
想要一个源码
' U+ W% u1 h9 E' P, b
源码在附件
回复

使用道具 举报

153

主题

110

听众

1万

积分

解答支持团长

老菜鸟

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

签到天数: 240 天

[LV.8]以坛为家I

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

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

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

使用道具 举报

24

主题

2

听众

3521

积分

LV.10

Rank: 10Rank: 10Rank: 10

签到天数: 160 天

[LV.7]常住居民III

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

使用道具 举报

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-3-2 21:11 |显示全部楼层
zhouyiran1@126.com 发表于 2013-3-2 20:45
* p' c5 F! @% d  o! z) g3 d继续学习!收藏+顶帖+送分,老夫的三件套奉上!
3 m/ m$ @& \& H
收下了三件套
回复

使用道具 举报

19

主题

111

听众

5338

积分

技术分享团长

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

签到天数: 5 天

[LV.2]偶尔看看I

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

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

发表于 2013-3-4 10:55 |显示全部楼层
前来学习,感谢天远!
2 w3 q9 x9 C' H" m7 x: q批量工作表重命名,太给力了!{:soso_e183:}
回复

使用道具 举报

46

主题

0

听众

588

积分

LV.5

Rank: 5Rank: 5

该用户从未签到

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

使用道具 举报

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

快速回帖:

fastpost

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

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

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部