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

 找回密码
 
查看: 32726|回复: 146

[VBA/VBS教程] 自动建立工作表目录(工作表太多时的最佳助手)

    [复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-10-17 12:09 |显示全部楼层
分享到: 新浪微博 腾讯微博
本帖最后由 天远 于 2012-10-17 12:11 编辑 ( r1 N8 W4 @1 g. d) Q

2 C) D! w9 o9 {5 C+ X% k( y/ J如果在一个工作簿中有许多工作表,使用时往往会建立一张目录表并插入超链接以方便选择工作表。
, k2 _: ]9 d# H但是如果工作簿中的工作表经常添加和删除,使用手工建立目录很不方便。
5 j1 r. X# @- j% o9 c8 F此时可以使用工作表的Activate事件自动建立工作表的目录。
% ~* P6 f# Z; s% z$ `先看看效果图吧,如图所示:
: d) O9 }0 N1 d) O- A9 J; |, P* l" m# z- J5 P) c% W! d

) U& e2 E6 f- e. f' C9 e1 F下面是所有的代码:
% i+ V* b& Z! N% u# M(实现这个功能要用的代码不多,却很实用哦,天远加了详细的注释以方便初学VBA的朋友阅读学习,当然高手请勿怪哈)
  1. Option Explicit '开启强制显式类型声明
    4 |% U# k( L0 v( ?, p

  2. ( Q* \; I3 o+ s
  3. '工作表的Activate事件,在“目录”工作表激活时自动建立工作簿中除“目录”工作表外所有工作表的目录。
    3 ~: d, d5 |& R( ^, Q
  4. Private Sub Worksheet_Activate()( m0 u4 z5 n1 c- r' M9 F, V
  5. Dim Sht As Worksheet
    ; X' U* b/ F5 y0 `5 {7 i' y. B
  6. Dim a As Integer. n) W# ]) K: j  `
  7. Dim r As Integer0 I" L' G5 C3 L, u( E' o( T6 M
  8. r = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后非空单元格的行号
    8 A* i3 ?7 x$ J5 S
  9. a = 2 '设置变量a的初始值为2,从A2单元格开始建立工作表目录
    ! x4 N* Q2 T! F% k7 \* q
  10. '判断是否存在工作表目录,如果存在先清空原来的目录,以便更新目录。. D6 ?+ [$ V9 K' S
  11. If r > 1 Then Range("A2:A" & r).ClearContents : Q5 \, ]+ _' L- I
  12. '遍历工作簿的所有工作表,将除“目录”工作表外所有工作表的名称写入到A列单元格中 2 v5 S9 R9 o" |
  13. For Each Sht In Worksheets: w, ~5 d$ l* E0 v* O! J; C, Z
  14. If Sht.CodeName <> "Sheet1" Then 'CodeName是指在VBA中工作表对应的名称
    4 B1 A/ ]2 f& G2 G- [; E: m
  15. Cells(a, 1).Value = Sht.Name 'Name就是指我们看到的工作表标签中的文本- |5 h' N- |/ f* T% C1 }
  16. a = a + 1
    . B  U1 A9 F' j* O' B) T
  17. End If
    $ Z! o  Z7 D, C7 Z1 _
  18. Next
    * _5 A/ _& a1 }) s; Y
  19. Set Sht = Nothing' M' F6 s/ `: W. u8 L" q
  20. End Sub; a# m0 }# @2 N2 \  I  R
  21. 6 m( t( M& ?3 z5 p. L2 y
  22. '工作表的SelectionChange事件,当选择A列工作表目录中工作表名称时自动选择该单元格所对应的工作表2 K: m1 a9 z$ s; U4 x4 f  t6 \
  23. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    $ ]! n( r, G% z- f& P# C0 X% w
  24. Dim r As Integer* v) x6 L0 x! n6 ?) L/ r
  25. r = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后非空单元格的行号4 }% `4 _$ D. \( o
  26. On Error Resume Next. G, o1 U% r% S1 i! E
  27. '如果选择的单元格区域和A2:Ar区域没有重叠部分是假的话(即选择的单元格区域在A2:Ar区域)+ N8 L: J* [0 \( D4 Q$ q! S
  28. If Not Application.Intersect(Target, Range("A2:A" & r)) Is Nothing Then4 a. c2 K- B( e* i9 ~# z
  29. Sheets(Target.Text).Select '选择单元格所对应的工作表
    " \4 b2 m1 v6 p. y+ I% E3 n2 l
  30. End If( u' o9 v+ U) c6 {# U1 _
  31. End Sub
复制代码
最后,已经是老规矩了吧,天远总是会把我的测试文档发出来,真正做到有文档有真相。而且是ET格式的,咱们这是WPS论坛嘛,多多支持WPS自有的格式啊!
3 b3 G+ X0 r) e$ _8 J1 eET文档:
* N0 c8 O9 L# R% P6 M$ F1 m# s: D6 o6 c

本帖子中包含更多资源

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

已有 5 人评分威望 收起 理由
翘尾的k + 3 很给力!
松风水月 + 10 赞一个!
zhouyiran1@126.com + 20 很给力!
weichao321 + 8 赞一个!
quelea + 10 很给力!

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

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

154

主题

27

听众

5095

积分

解答支持团员

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

签到天数: 1 天

[LV.1]初来乍到

金币
2784
威望
11083
帖子
2618
精华
0

技术分享团 解答支持团 测试体验团 优秀会员奖 活跃会员奖 乐于助人奖 技巧教程分享达人

发表于 2012-10-17 12:28 |显示全部楼层
@zhouyiran1@126.com
$ Q# r  Z3 E) P
$ p. p4 v! I% G1 u( H, Y! w" V. {% }+ {又多一个选择。; f! ^( {" N  f  [
5 |( r. W2 A' s3 E* e# T
我前面做过一个独立的vbs程序。(因为个人版不自带vba,可能普通用户没办法用,所以用vbs写)* R9 f, S& d7 X5 `7 V" E0 v$ r  R
http://bbs.wps.cn/thread-22346637-1-1.html
已有 1 人评分威望 收起 理由
zhouyiran1@126.com + 10 赞一个!

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

回复

使用道具 举报

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-10-17 12:38 |显示全部楼层
quelea 发表于 2012-10-17 12:28 ( X- N1 Z! Q- j; |- d4 {
@ 2 X' N' o7 A. C" j  a8 u: l
* g6 ^* @, |, [! P& C! N4 ~
又多一个选择。
- T; H" Q  T1 K3 \" r# n" ~! O) M( n
向前辈致意了,之前没看到你的帖子,如果看到,就不出来献丑了
已有 1 人评分威望 收起 理由
zhouyiran1@126.com + 10 赞一个!

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

回复

使用道具 举报

87

主题

402

听众

8389

积分

LV.15

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

该用户从未签到

金币
2407
威望
14021
帖子
7002
精华
7

技术分享团 解答支持团 重阳节勋章 勤奋版主奖 最佳教程奖 活跃会员奖 优秀会员奖 乐于助人奖 技巧教程分享达人

发表于 2012-10-17 14:10 |显示全部楼层
有注释,适合咱这些菜鸟理解,给力!{:soso_e142:}
已经消失了,就不要再联系。
回复

使用道具 举报

2

主题

4

听众

106

积分

LV.3

Rank: 3Rank: 3

该用户从未签到

金币
0
威望
218
帖子
70
精华
0

WPS粉丝团

发表于 2012-10-17 15:00 |显示全部楼层
要好好学习了啊
回复

使用道具 举报

1

主题

0

听众

63

积分

LV.2

Rank: 2

签到天数: 1 天

[LV.1]初来乍到

金币
7
威望
89
帖子
68
精华
0
发表于 2012-10-28 00:02 |显示全部楼层
谢谢楼主分享。
回复

使用道具 举报

53

主题

59

听众

6715

积分

版主

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

签到天数: 126 天

[LV.7]常住居民III

金币
634
威望
13773
帖子
3973
精华
2

WPS粉丝团 技术分享团 乐于助人奖 技巧教程分享达人 优秀会员奖 活跃会员奖 测试体验团 版主勋章 勤奋版主奖 最佳教程奖 测试体验官 优秀模板奖

发表于 2012-10-29 14:09 |显示全部楼层
{:1_10:}用不了那个功能,怎么办?

点击了解最新动态:【轩少】__实用教程索引(2015-9-6更新)
http://bbs.wps.cn/forum.php?mod= ... amp;fromuid=2404273
回复

使用道具 举报

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-10-29 20:19 |显示全部楼层
轩少 发表于 2012-10-29 14:09 5 x6 J5 ?( O' T
用不了那个功能,怎么办?

& _3 A# b0 P, _- W' U; ^) }  |5 J是不是你没有VBA环境,这个功能是一个宏,你要从宏功能里去找
回复

使用道具 举报

53

主题

59

听众

6715

积分

版主

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

签到天数: 126 天

[LV.7]常住居民III

金币
634
威望
13773
帖子
3973
精华
2

WPS粉丝团 技术分享团 乐于助人奖 技巧教程分享达人 优秀会员奖 活跃会员奖 测试体验团 版主勋章 勤奋版主奖 最佳教程奖 测试体验官 优秀模板奖

发表于 2012-10-29 22:23 |显示全部楼层
天远 发表于 2012-10-29 20:19 - T8 |9 s' }+ B
是不是你没有VBA环境,这个功能是一个宏,你要从宏功能里去找

$ O+ ~+ M6 h5 _7 `# W我没有那个,哪里有????
回复

使用道具 举报

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-10-29 22:49 |显示全部楼层
轩少 发表于 2012-10-29 22:23 , t+ H, Z# h5 j% K0 c+ M# `
我没有那个,哪里有????

* E1 a% z1 [1 `1 _在开发工具选项卡上的宏按钮。如果是灰的,说明你没有VBA环境,你可以下载一个VBA安装,资料在这个帖子http://bbs.wps.cn/thread-22347925-1-1.html
回复

使用道具 举报

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

快速回帖:

fastpost

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

GMT+8, 2017-11-25 09:43

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部