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

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

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

[复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-2-28 16:30 |显示全部楼层
分享到: 新浪微博 腾讯微博
功能:批量重命名当前工作簿中的工作表0 F: f! d$ J! p& @

3 h4 S' h/ R9 ?: [, E功能演示:
( a' s& n2 R' x* G* {; M% V1 t* ]* N# X5 o  g. ?/ M; F  X
, @7 }, H# h; Q- o. Y) B( \3 Q
+ y3 u6 d6 E: ?1 p3 _
& Z5 p! @9 v  x" T4 P& V" Z
1 ^, v& Q1 [  x

' W+ H) a( I% E, x& d- q' o# d$ U* h) s1 i- w+ A

" a* Y' x: N% ~9 E+ {' a2 E3 C! h3 k! v: \; y$ w0 W

$ Y' }7 J* L4 C1 l
; _3 Y! ?$ z: Y1 o, jVBA源代码解读(附件中还提供VBS脚本):& Z. h, _1 r$ K2 p
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) '批量工作表重命名8 P- H4 A! D, I, h( E$ w: b) o
02 On Error Resume Next
) x5 t! D( q: s% I9 P' U% R03 Application.ScreenUpdating = False '关闭屏幕更新,加快速度7 _% g: I) L: e* @  a
04 Dim AcWss As Worksheets. V# o4 m1 r! c0 m' i  m
05 Set AcWss = Application.ActiveWorkbook.Worksheets4 \9 H& h( E4 r# P" M2 f  I! }
06 If ShtStart < 1 Then ShtStart = 1* t* r* F' I. w7 O1 ~; G
07 If ShtStart > AcWss.Count Then ShtStart = AcWss.Count
5 f) c5 s1 O" R# o08 If ShtEnd < 1 Then ShtEnd = 1
  G* ~8 ?3 |7 y) p* H9 s. \+ Q09 If ShtEnd > AcWss.Count Then ShtEnd = AcWss.Count
# L3 n. F) [' `; a10 If ShtStart > ShtEnd Then5 c0 A9 X. w& F1 b6 B' R/ o! Z
11     Dim ShtTemp As Integer
9 M- n; L( j; w2 O12     ShtTemp = ShtStart
, N; e" J. ~  Y/ N* o  F+ |6 ~- y9 @13     ShtStart = ShtEnd/ v; |1 H) w# l8 {0 A5 S
14     ShtEnd = ShtTemp. D' }' `* c0 I$ ]6 C
15 End If
+ s' z! J# ~. g" z2 W+ W16 If 0 = Numstep Then Numstep = 1
0 G0 M- E  P3 M- V  h' O& X17 Dim i As Integer
( J: N. H' D( z6 {0 M18 For i = ShtStart To ShtEnd
8 }& S% ^5 f' \. d" r% Q  _4 O% n19     AcWss(i).Name = StrStart & NumStart & StrEnd1 N1 k2 G) Z3 t7 O. {
20     NumStart = NumStart + Numstep
! L+ @7 u0 {/ [: Q/ p8 \, T9 q21 Next i
. a% B3 V  M+ x  J1 Z5 @8 N22 MsgBox "批量工作表重命名成功!", 0 + 64, "天远ET工具箱"( U7 o' z; W  d* p7 {. c* e; e
23 Application.ScreenUpdating = True
3 Q3 }1 T  x7 x24 End Sub
8 g2 |' V- \$ Q! N' v! _25 & H, I7 y7 B: W2 R0 D( U
26 Public Sub RenameWorksheetsSub() '批量工作表重命名
4 R$ ^* k4 Z' z; H2 v( W6 V* }27 On Error Resume Next; T( k% o; `' ^* {( }' g  V
28 Application.ScreenUpdating = False '关闭屏幕更新,加快速度; t, H& \, c8 g3 b* o
29 Dim AcWss As Worksheets
% I: F* [( W7 A/ E' E  W, h* C6 w30 Set AcWss = Application.ActiveWorkbook.Worksheets' y# r: ]0 E- O8 U* O
31 Dim istr1, istr2, istr3, istr4, istr5, istr6, str As String
/ ]$ V( V1 k; d" s32 str = "请输入起始工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"
& H! a+ c7 n2 |+ c$ B% z' P( k33 istr1 = InputBox(str, "天远ET工具箱", 1)2 c0 t- N$ H: q
34 str = "请输入终止工作表号" & vbCrLf & vbCrLf & "当前总共有" & AcWss.Count & "张工作表"
; L1 I% H  Z0 W5 G35 istr2 = InputBox(str, "天远ET工具箱", AcWss.Count)
' y8 ~2 C/ N/ [9 e+ p* Y36 str = "请输入工作表名称前缀(序号前)" & vbCrLf & vbCrLf & "允许为空"
; w9 \: d; C4 y5 p37 istr3 = InputBox(str, "天远ET工具箱", "前缀")6 s( D8 g1 |0 w1 z
38 str = "请输入工作表名称后缀(序号后)" & vbCrLf & vbCrLf & "允许为空"
* C8 |  W# \' E39 istr4 = InputBox(str, "天远ET工具箱", "后缀")
; |9 l9 \4 m; c. V& H40 str = "请输入工作表名称起始序号" & vbCrLf & vbCrLf & "允许非正数"
9 Q4 L8 c' C" ^- W41 istr5 = InputBox(str, "天远ET工具箱", 1)8 V- E/ R9 t/ V) f1 H# Y$ L. E
42 str = "请输入工作表名称序号步长" & vbCrLf & vbCrLf & "允许非0整数,为0时自动转换成1"7 V; O' ^2 E/ j6 C0 q
43 istr6 = InputBox(str, "天远ET工具箱", 1)  \8 n9 ^8 N& |* g$ ^
44 Call RenameWorksheets(Int(istr1), Int(istr2), istr3, istr4, Int(istr5), Int(istr6))
/ `7 ]3 e+ ]# |; k45 Application.ScreenUpdating = True" t$ a/ [7 M1 C) U+ Y
46 End Sub
6 \0 ?8 d& V5 }" c' s& q7 F4 t. A8 u; v
* h. J8 @. a+ [# L8 R6 j; W% S

: X' n" m0 n( k  e: N7 W0 p/ P; ]3 p3 N
附件:天远批量工作表重命名VBA版和VBS版(使用VBA版需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)8 C' I: v& [# `$ o% ?. s
游客,如果您要查看本帖隐藏内容请回复
* O1 E" s6 a, `  Q' k) l1 u
使用天远ET工具箱不需要VBA环境,天远ET工具箱即将加入批量工作表重命名功能,敬请期待。
# S  m. ?9 N5 W4 m6 Y+ \& h  z
$ X' d2 p6 p/ F+ X( M, V
' Q! w" z! ^# N. K! [

本帖子中包含更多资源

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

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

听众

29

积分

LV.1

Rank: 1

签到天数: 2 天

[LV.1]初来乍到

金币
1
威望
11
帖子
39
精华
0
发表于 2013-3-2 16:41 |显示全部楼层
想要一个源码; d9 h2 \  H# [/ K
回复

使用道具 举报

9

主题

22

听众

1万

积分

测试体验团员

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

签到天数: 1146 天

[LV.10]以坛为家III

金币
2118
威望
26157
帖子
6150
精华
0

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

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

使用道具 举报

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-3-2 19:01 |显示全部楼层
zhangop9 发表于 2013-3-2 16:41
# ]& u* G; T3 _想要一个源码
8 T% K; [9 {1 L3 `$ M
源码在附件
回复

使用道具 举报

153

主题

109

听众

1万

积分

解答支持团长

老菜鸟

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

签到天数: 240 天

[LV.8]以坛为家I

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

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

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

使用道具 举报

23

主题

1

听众

3493

积分

LV.10

Rank: 10Rank: 10Rank: 10

签到天数: 160 天

[LV.7]常住居民III

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

使用道具 举报

84

主题

59

听众

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& L# F0 t3 d3 N. `
继续学习!收藏+顶帖+送分,老夫的三件套奉上!
7 `. c# f( N2 O
收下了三件套
回复

使用道具 举报

19

主题

106

听众

5338

积分

技术分享团长

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

签到天数: 5 天

[LV.2]偶尔看看I

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

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

发表于 2013-3-4 10:55 |显示全部楼层
前来学习,感谢天远!5 e" X; U+ ^" V# ^, R! n
批量工作表重命名,太给力了!{: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-11-18 14:23

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部