给工作表创建带按钮的索引页，和上百个工作表打交道的人有福了

liucqa

年底前，老婆大人的单位要做明年的预算，给她们的模板居然脑残到有96个sheet。这要是用鼠标在导航栏一个个点，手岂不是要抽筋！
而且每次打开文件不需要看全部的sheet，只看其中的十几个。
考虑再三，俺还是心疼老婆大人，决定做一个能够添加索引按钮的宏，解脱老婆的食指，同时方便广大做表格的劳苦小民。

源码奉上（里面部分功能参考几个论坛上各个帖子，在此不能一一列举，谨致感谢）

功能：可以完整无损的copy原文件的sheets至本文件，同时修改原文件内部的excel链接至本文件自身。支持文件打开密码和工作表保护密码输入。但不能支持不同工作表不同密码的情况（有需求的可以自己改程序，也不难）。

索引使用方法：按下指定的控件按钮，对应的sheet显示。再按一次按钮，对应的sheet隐藏。显示出来的sheet左上角有返回索引页的链接。



如果诸位试用有问题，请留贴说明报错的信息，并附上至少一个sheet，我会研究修改。

附件更新v1.41版（Excel2007测试通过），修改一处bug。执行文件时，自检测打开“信任对VBA工程的访问”，执行完毕自动关闭。所以为保安全，程序打开之后至少要执行一次或者手动关闭信任。
给工作表创建按钮V1.411.rar (50.07 KB, 下载次数: 556)

2013-9-23 10:39 上传

点击文件名下载附件

************************************************************************
更新1.411版，补上关闭工作簿时，自动取消“信任对VBA工程的访问”的功能
在2013测试通过

2013.9.23

Samsea

其实只要做Hyerlink就行。
我有一个文件有60多个Sheet，在数据汇总的第一页设置了Hyerlink。很好用。但这个文件用你的办法出错。

liucqa

Samsea 发表于 2011-8-26 16:35
其实只要做Hyerlink就行。
我有一个文件有60多个Sheet，在数据汇总的第一页设置了Hyerlink。很好用。但这个 ...

发一个附件上来（带1个sheet就行）。  因为控件按钮可以调整背景颜色，容易做区分，看着也漂亮一些。

Samsea

liucqa 发表于 2011-8-26 19:04
发一个附件上来（带1个sheet就行）。  因为控件按钮可以调整背景颜色，容易做区分，看着也漂亮一些。

发一个附件只带三个sheets。运行发生错误。


9月份钢筋出货月报表.zip (27.28 KB, 下载次数: 195)

2011-8-26 17:52 上传

点击文件名下载附件

liucqa

Samsea 发表于 2011-8-26 17:57
发一个附件只带三个sheets。运行发生错误。

有两个错误，一个是内存溢出，这个是打开你的文件之后你的文件里面的宏自动运行报的错误，不是我的文件报的错误，具体我没有分析。这个问题在程序最前面加一句Application.EnableEvents = False就可以解决。

Private Sub Worksheet_Activate()
  Dim I%, J%, K%, M%, NoSh%, arr2
  
    Sheets(1).Unprotect
  
    MRR = Cells(65536, 2).End(xlUp).row - 1
    MR = Cells(MRR, 2).End(xlUp).row
    NoSh = ThisWorkbook.Sheets.Count
    ReDim arr2(5 To NoSh, 3 To 34)                                                                            就是这句报内存溢出
  
  For I = 5 To NoSh                        '每表
    With Sheets(I)
        RowL = .[D65536].End(xlUp).row
        For K = 3 To RowL                  '每行
            For J = 3 To 33                '每天
                If .Cells(K, 1) = Cells(1, J) And Cells(1, J) <> Empty Then Exit For
            Next
            arr2(I, J) = arr2(I, J) + .Cells(K, 4)
        Next
    End With
Next

[C2].Resize(MR - 1, 32) = arr2
Erase arr2
    Sheets(1).Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingColumns:=True, AllowFormattingRows:=True

End Sub

第二个错误：删掉你的内置宏之后再运行我的文件， 报copy方法无效，这个与你的sheet格式有关，有一个基本数据的表是深度隐藏，不能拷贝，回头我改改程序。

谢谢你提供样本。我一直想用VBA彻底实现建立副本的功能，但需要不同的样本测试

liucqa

更新1.3版，
1、增加对深度隐藏工作表的判断，发现之后属性改成0。
2、屏蔽应用程序事件，防止在拷贝时Worksheet_Activate()自动运行
3、增加错误捕捉。

附件在一楼

lhsh36183

liucqa 发表于 2011-8-26 18:54
更新1.3版，
1、增加对深度隐藏工作表的判断，发现之后属性改成0。
2、屏蔽应用程序事件，防止在拷贝时Wo ...

谢谢分享，能不能给个2003版本。因为无法转换。

liucqa

lhsh36183 发表于 2011-8-26 19:59
谢谢分享，能不能给个2003版本。因为无法转换。

我没有2003，所以也不知道需要改什么地方，把你使用时的报错信息贴上来看看。如果是ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3  引用问题的话，就只能自己找文件了

liucqa

还有没有人用这个发现报错的，有的话发个附件！

liucqa

还有没有人用这个发现报错的，有的话发个附件！